home *** CD-ROM | disk | FTP | other *** search
/ BCI NET 2 / BCI NET 2.iso / archives / programming / arexx / gwrapper30.lha / FinalWrapper3_0 / FinalWrapper.rexx < prev    next >
Encoding:
OS/2 REXX Batch file  |  1995-01-29  |  52.5 KB  |  2,439 lines
  1. /* $VER: FinalWrapper 3.0 (29.01.95) by NDY's */
  2. version="3.0"
  3. date="29.01.95"
  4. OPTIONS RESULTS
  5. SIGNAL ON ERROR
  6. SIGNAL ON SYNTAX
  7. SIGNAL ON BREAK_C
  8. ARG cliarg
  9. initerr=init()
  10. rxport=ADDRESS()
  11. IF ~(Left(rxport,Length(finalw))=finalw) THEN
  12. DO
  13. DO i=1 TO 20 UNTIL portok
  14. rxport=finalw||i
  15. portok=Show("p",rxport)
  16. END
  17. IF portok THEN ADDRESS VALUE rxport
  18. END
  19. portok=Show("p",rxport)
  20. CALL locale
  21. CALL checkenv
  22. CALL loaddef(1)
  23. pubonly=~check.mscr
  24. IF portok & ~pubonly & fwkey~="" THEN
  25. DO
  26. SIGNAL OFF ERROR
  27. ADDRESS COMMAND ''fwkey''
  28. SIGNAL ON ERROR
  29. IF RC=0 THEN
  30. pubonly=1
  31. ELSE
  32. customscr=D2C(RC,4)
  33. END
  34. ELSE
  35. pubonly=1
  36. IF portok THEN
  37. DO
  38. GetDocItemPrefs "DECIMAL"
  39. deci=Upper(RESULT)
  40. DocItemPrefs "DECIMAL PERIOD" 
  41. CALL options
  42. CALL chosenobjs
  43. CALL oval
  44. CALL scan
  45. CALL resetprefs
  46. END
  47. meas=measure.4
  48. IF portok THEN
  49. DO
  50. GetDisplayPrefs "MEASURE"
  51. RESULT=Upper(RESULT)
  52. SELECT
  53. WHEN RESULT="INCHES" THEN meas=measure.1
  54. WHEN RESULT="METRIC" THEN meas=measure.2
  55. WHEN RESULT="PICA" THEN meas=measure.3
  56. OTHERWISE NOP
  57. END
  58. END
  59. DO id=agads+1 TO agads+sgads
  60. ltxt.id=replacepat(ltxt.id,"%m",meas)
  61. END
  62. IF guiinit()=5 THEN CALL message(50,nogui)
  63. init=0
  64. DO FOREVER
  65. CALL OnMenu(win,1024)
  66. IF ~zoomed THEN CALL ZipWindow(win)
  67. CALL ScreenToFront(scr)
  68. CALL ActivateWindow(win)
  69. CALL SetWindowTitles(win,wintitle,scrtitle)
  70. IF Left(text,Min(len.tgad,Length(text)))~=val.tgad THEN text=val.tgad
  71. DO UNTIL portok
  72. closed=0
  73. DO UNTIL closed~=0
  74. DO UNTIL closed~=0
  75. CALL WaitPkt(portname)
  76. CALL messy
  77. END
  78. DO id=1 TO agads+sgads
  79. IF labs.id>0 THEN CALL checkstrgad
  80. END
  81. IF closed=winclose | closed=okclose & prefsstore THEN CALL savedef(1)
  82. IF closed=cancelclose | closed=winclose THEN
  83. DO
  84. CALL bye(0)
  85. closed=0
  86. END
  87. IF closed=rxclose THEN
  88. DO
  89. ADDRESS COMMAND "Run >NIL: Rx "||defdir
  90. closed=0
  91. END
  92. IF closed=nextclose THEN
  93. DO
  94. ADDRESS VALUE rxport
  95. portok=1
  96. CALL newdoc
  97. closed=0
  98. END
  99. END
  100. closed=0
  101. portok=Show("P",rxport)
  102. IF ~portok THEN
  103. DO
  104. DO i=1 TO 20 UNTIL portok
  105. rxport=finalw||i
  106. portok=Show("p",rxport)
  107. END
  108. CALL newdoc
  109. END
  110. IF ~portok THEN
  111. CALL message(0,nofw)
  112. ELSE
  113. ADDRESS VALUE rxport
  114. END
  115. zoomed=BitTst(D2C(GETVALUE(win,24,4,"N")),28)
  116. IF ~zoomed THEN CALL ZipWindow(win) 
  117. CALL SetWindowTitles(win,aborttitle,busytitle)
  118. ScreenToFront
  119. CALL OffMenu(win,1024)
  120. GetDocItemPrefs "DECIMAL"
  121. deci=Upper(RESULT)
  122. DocItemPrefs "DECIMAL PERIOD" 
  123. CALL options
  124. IF chosenobjs()=0 THEN
  125. DO
  126. CALL oval
  127. CALL scan
  128. IF closed=0 THEN CALL text
  129. IF closed=0 THEN CALL wrap
  130. IF closed=0 THEN CALL group
  131. CALL updategadgets
  132. IF stilltoreply THEN
  133. DO
  134. CALL Reply(replymsg,0)
  135. stilltoreply=0
  136. END
  137. END
  138. CALL resetprefs
  139. END
  140. CALL bye(5)
  141. init: 
  142. init=1
  143. errtext="%t (#%n)|in line %l"
  144. lockcnt=0
  145. errtrap=0
  146. getscrn=0
  147. objs=0
  148. sobjs=0
  149. deci=""
  150. et=""
  151. cleangui=0
  152. stilltoreply=0
  153. replymsg="00000000"x
  154. apig=1
  155. lib.apig=0
  156. reqtools=4
  157. lib.reqtools=0
  158. win="00000000"x
  159. defprfs=""
  160. defspecs=""
  161. defcolour=""
  162. deffont=""
  163. portname="FinalWrapperPort"
  164. IF Show("P",portname) THEN
  165. DO
  166. ADDRESS VALUE portname
  167. IF cliarg~="" THEN
  168. INTERPRET cliarg
  169. ELSE
  170. PopFront
  171. CALL bye(0)
  172. END
  173. fwkey="ENVARC:FinalWrapper/FWKeyfile"
  174. libs=5
  175. DO i=1 TO libs
  176. lib.i=0
  177. END
  178. library.apig="apig.library"
  179. library.2="rexxmathlib.library"
  180. library.3="rexxsupport.library"
  181. library.reqtools="rexxreqtools.library"
  182. guidelib=5
  183. library.guidelib="amigaguide.library"
  184. DO libn=1 TO libs
  185. lib.libn=Show("l",library.libn)
  186. IF ~lib.libn THEN lib.libn=AddLib(library.libn,0,-30,0)
  187. IF ~lib.libn & libn~=guidelib & libn~=reqtools THEN RETURN 14
  188. END
  189. help=lib.guidelib
  190. defdir=""
  191. temp=""
  192. preff.1=""
  193. preff.2=""
  194. IF xexists("ENV:FinalWrapper") THEN
  195. DO
  196. preff.1="ENV:FinalWrapper/FinalWrapper.def"
  197. temp="ENV:FinalWrapper/FinalWrapper.temp"
  198. IF Open(prefs,"ENV:FinalWrapper/FWPath","R") THEN
  199. DO
  200. defdir=ReadLn(prefs)
  201. CALL Close(prefs)
  202. END
  203. END
  204. IF xexists("ENVARC:FinalWrapper") THEN preff.2="ENVARC:FinalWrapper/FinalWrapper.def"
  205. finalw="FINALW."
  206. libn=libs
  207. port=0
  208. oldlen=0
  209. oldtxt=0
  210. oldoval=0
  211. oldobjs=0
  212. oldpara=-1
  213. oldppos=-1
  214. oldplen=-1
  215. txt=0
  216. oval=0
  217. rx=0
  218. ry=0
  219. ovalx=""
  220. ovaly=""
  221. ovalw=""
  222. ovalh=""
  223. ovalp=""
  224. text=""
  225. mchks=0
  226. macts=0
  227. agads=0
  228. sgads=0
  229. tgads=0
  230. wgads=0
  231. slines=0
  232. ovalscanned=0
  233. gadgettext=0
  234. virtualtext=1
  235. alen=0
  236. txtrot=0
  237. windowpos=0
  238. prefsstore=1
  239. trapped=0
  240. specs.0=""
  241. font.0=""
  242. colour.0=""
  243. dirtysize=1
  244. sheetused=0
  245. dirtytext=1
  246. RETURN 0
  247. locale: 
  248. return=13 ; esc=27 ; bs=8 ; del=127
  249. IF xexists("ENV:") THEN
  250. ok=Open(prefs,"ENV:Language","R")
  251. ELSE
  252. ok=0
  253. IF ok THEN
  254. DO
  255. language=ReadLn(prefs)
  256. CALL Close(prefs)
  257. END
  258. ELSE
  259. language="english"
  260. IF language="deutsch" THEN 
  261. DO
  262. measure.1="Zoll"
  263. measure.2="cm"
  264. measure.3="Pica"
  265. measure.4="?"
  266. docname="FinalWrapperSmallD.Guide"
  267. origwintitle="%i - %f"
  268. origscrtitle="%i - %f"
  269. unnamed="Unbenannt"
  270. defwinx=0
  271. defwiny=0
  272. aborttitle="<- Abbrechen"
  273. busytitle="%i - Am Arbeiten, bitte warten..."
  274. gnode.0="REQUESTER"
  275. mnode.0="MENU"
  276. stdbut="OK"
  277. errtext="FinalWrapper-Fehler:|%t|in Zeile %l:|<%s>|(Fehlernummer %n)"
  278. nolib="FinalWrapper-Fehler:|Konnte '%y' nicht öffnen!"
  279. nofw="Erst mal Final Writer starten!"
  280. noselect="FinalWrapper-Fehler:|Zuerst einen Textblock oder einen|Textausschnitt und ein Objekt|wählen oder die Werte in die|entsprechenden Felder eingeben!"
  281. wrongos="FinalWrapper-Fehler:|Es wird mindestens OS2.0 benötigt!"
  282. nogui="FinalWrapper-Fehler:|Konnte Requester nicht öffnen!"
  283. notnum="%g|Numerischer Wert erforderlich!"
  284. noreqtools="Konnte rexxreqtools.library nicht öffnen!"
  285. nohelp="Online Help nicht verfügbar!"
  286. rxcmderr="Unbekannter Arexx-Befehl|oder Syntaxfehler:|%c"
  287. rxfilerq="Arexx-Makro starten:"
  288. rxfileok="OK"
  289. about="FinalWrapper %v (%d)||Vorschläge & Fehler sind zu richten an:|    Andreas Weiss|    Dorfstrasse 24|    CH-8212 Nohl|    (Schweiz)||Dieses Programm ist SHAREWARE!|Die Gebühr beträgt sfr/DM 20 oder $15"
  290. arc=newgadget(2,"n",1,360,0,"ARC",0,9999)
  291. ltxt.arc.1="Nutze Sektor °: Uhrzeiger"
  292. ltxt.arc.2="Nutze Sektor °: Gegenuhrz."
  293. beg=newgadget(3,"p",0,0,0,"BEGIN",0,359)
  294. ltxt.beg.1="Position °: Absolut"
  295. ltxt.beg.2="Position °: Uhrzeigersinn"
  296. ltxt.beg.3="Position °: Gegenuhrzeiger"
  297. rot=newgadget(6,"r",0,0,0,"ROTATE",0,359)
  298. ltxt.rot.1="Rotation °: Absolut"
  299. ltxt.rot.2="Rotation °: Wie Textblock"
  300. ltxt.rot.3="Rotation °: Uhrzeigersinn"
  301. ltxt.rot.4="Rotation °: Gegenuhrzeiger"
  302. ltxt.rot.5="Rotation °: Delta Uhrz."
  303. ltxt.rot.6="Rotation °: Delta Gegenuhr"
  304. dlt=newgadget(-4,"l",0,0,0,"DELETE")
  305. ltxt.dlt.1="Löschen: Nichts"
  306. ltxt.dlt.2="Löschen: Nur Oval"
  307. ltxt.dlt.3="Löschen: Oval und Textblock"
  308. ltxt.dlt.4="Löschen: Oval kopieren"
  309. grp=newgadget(-3,"g",0,0,0,"GROUP")
  310. ltxt.grp.1="Gruppieren: Nein"
  311. ltxt.grp.2="Gruppieren: Ausgewähltes Oval"
  312. ltxt.grp.3="Gruppieren: Unsichtbares Oval"
  313. wrd=newgadget(0,"w",0,0,0,"WORDMODE")
  314. ltxt.wrd="Worte zusammensetzen"
  315. spl=newgadget(2,"s",0,25,0,"SPIRAL",1,100)
  316. ltxt.spl.1="Spirale %: Aussen -> innen"
  317. ltxt.spl.2="Spirale %: Innen -> aussen"
  318. siz=newgadget(2,"z",0,100,0,"SIZE",1,100)
  319. ltxt.siz.1="Zeichengröße %: Sinkend"
  320. ltxt.siz.2="Zeichengröße %: Steigend"
  321. zoo=newgadget(3,"v",0,50,0,"ZOOM",1,1000)
  322. ltxt.zoo.1="Vergrössern %: Alles"
  323. ltxt.zoo.2="Vergrössern %: Höhe"
  324. ltxt.zoo.3="Vergrössern %: Breite"
  325. ink=newgadget(-5,"f",0,0,0,"COLOUR")
  326. ltxt.ink.1="Farbe: Wie Text"
  327. ltxt.ink.2="Farbe: Wie Ovalfüllung"
  328. ltxt.ink.3="Farbe: Wie Ovalrahmen"
  329. ltxt.ink.4="Farbe: Schatten Füllfarbe"
  330. ltxt.ink.5="Farbe: Schatten Rahmenfarbe"
  331. adj=newgadget(-5,"k",0,0,0,"ADJUST")
  332. ltxt.adj.1="Korrigiere: Nichts"
  333. ltxt.adj.2="Korrigiere: Zeichengrösse"
  334. ltxt.adj.3="Korrigiere: Zeichenbreite"
  335. ltxt.adj.4="Korrigiere: Scheinbare Breite"
  336. ltxt.adj.5="Korrigiere: Sektorgrösse"
  337. adjarc=5
  338. pat=newgadget(0,"ü",0,0,0,"PATTERN")
  339. ltxt.pat="Übernehme Attribute von Auswahl"
  340. xgad=newstr(7,"x",1,"",1,"XPOS")
  341. ltxt.xgad="(%m) X:"
  342. ygad=newstr(7,"y",1,"",1,"YPOS")
  343. ltxt.ygad="Y:"
  344. wgad=newstr(7,"b",1,"",1,"WIDTH")
  345. ltxt.wgad="Breite:"
  346. hgad=newstr(7,"h",1,"",1,"HEIGHT")
  347. ltxt.hgad="Höhe:"
  348. pgad=newstr(4,"#",1,1,0,"PAGE")
  349. ltxt.pgad="# der Seite:"
  350. tgad=newstr(200,"t",2,"",2,"TEXT")
  351. ltxt.tgad="Text:"
  352. okgad=newbutton("  OK  ","o",RETURN,"OK")
  353. cancelgad=newbutton("Abbruch","a",esc,"CANCEL")
  354. closegad=newkey(del,"CLOSE")
  355. zipgad=newkey(" ","ZIP")
  356. depthgad=newkey(bs,"BACK")
  357. mtitle="Einstellungen"
  358. mgad=newchkitem("Gadgets aktivieren","G",1,"ACTIVATE")
  359. mspl=newchkitem("Korrigiere Sektor für Spiralen","K",1,"IMPROVE")
  360. mwin=newchkitem("Requester unter Mauszeiger","R",1,"WINDOW")
  361. mscr=newchkitem("Benutze Final Writers Screen","B",1,"SCREEN")
  362. mrel=newchkitem("Final Writer Version 3","F",1,"RELEASE")
  363. CALL newitem("","",mnode.0)
  364. mload=newitem("Laden","L","LOAD")
  365. msave=newitem("Sichern","S","SAVE")
  366. mres=newitem("Zurücksetzen","Z","RESET")
  367. mdef=newitem("Voreinstellungen","V","DEFAULTS")
  368. CALL newitem("","",mnode.0)
  369. mtext=newitem("Textblock-Einstellungen","T","TEXTPREFS")
  370. moval=newitem("Oval-Einstellungen","O","OVALPREFS")
  371. CALL newitem("","",mnode.0)
  372. mnext=newitem("Nächstes Dokument","N","NEXT")
  373. mrexx=newitem("Arexx-Makro starten...","A","MACRO")
  374. mhelp=newitem("Hilfe...","H","HELP")
  375. mabt=newitem("Über...","?","ABOUT")
  376. fwerrtext.5="Befehl schlug fehl"
  377. fwerrtext.10="Befehl gescheitert"
  378. fwerrtext.20="Ungültige Argumente"
  379. fwerrtext.100="Befehl unbekannt"
  380. fwerrtext.200="Kann fwarexx.library nicht öffnen"
  381. END
  382. ELSE 
  383. DO
  384. measure.1="Inch"
  385. measure.2="cm"
  386. measure.3="Pica"
  387. measure.4="?"
  388. docname="FinalWrapperSmall.Guide"
  389. origwintitle="%i - %f"
  390. origscrtitle="%i - %f"
  391. unnamed="Unnamed"
  392. defwinx=0
  393. defwiny=0
  394. aborttitle="<- Abort"
  395. busytitle="%i - Busy working, please wait..."
  396. gnode.0="REQUESTER"
  397. mnode.0="MENU"
  398. stdbut="OK"
  399. errtext="FinalWrapper failed:|%t|in line %l:|<%s>|(errornumber %n)"
  400. noselect="FinalWrapper failed:|First select an object and|a text block or some text|or enter the values in the|appropriate gadgets!"
  401. nolib="FinalWrapper failed:|Couldn't open '%y'"
  402. nofw="Run Final Writer first!"
  403. wrongos="FinalWrapper failed:|At least OS2.0 is required!"
  404. nogui="FinalWrapper failed:|Couldn't open requester!"
  405. notnum="%g|Value must be numeric!"
  406. noreqtools="Couldn't open rexxreqtools.library!"
  407. nohelp="On-line help not available!"
  408. rxcmderr="Unknown Arexx command|or syntax error:|%c"
  409. rxfilerq="Execute Arexx macro:"
  410. rxfileok="OK"
  411. about="FinalWrapper %v (%d)||For suggestions & bugs write to:|    Andreas Weiss|    Dorfstrasse 24|    CH-8212 Nohl|    (Switzerland)||This program is SHAREWARE!|The share is sfr/DM 20 or $15"
  412. arc=newgadget(2,"u",1,360,0,"ARC",0,9999)
  413. ltxt.arc.1="Use arc °: Clockwise"
  414. ltxt.arc.2="Use arc °: Anticlockwise"
  415. beg=newgadget(3,"b",0,0,0,"BEGIN",0,359)
  416. ltxt.beg.1="Begin °: Absolute"
  417. ltxt.beg.2="Begin °: Clockwise"
  418. ltxt.beg.3="Begin °: Anticlockwise"
  419. rot=newgadget(6,"r",0,0,0,"ROTATE",0,359)
  420. ltxt.rot.1="Rotate °: Absolute"
  421. ltxt.rot.2="Rotate °: Like text block"
  422. ltxt.rot.3="Rotate °: Clockwise"
  423. ltxt.rot.4="Rotate °: Anticlockwise"
  424. ltxt.rot.5="Rotate °: Delta clockwise"
  425. ltxt.rot.6="Rotate °: Delta anticlock"
  426. dlt=newgadget(-4,"d",0,0,0,"DELETE")
  427. ltxt.dlt.1="Delete: Nothing"
  428. ltxt.dlt.2="Delete: Oval only"
  429. ltxt.dlt.3="Delete: Oval and text block"
  430. ltxt.dlt.4="Delete: Copy oval"
  431. grp=newgadget(-3,"g",0,0,0,"GROUP")
  432. ltxt.grp.1="Group: No"
  433. ltxt.grp.2="Group: Selected oval"
  434. ltxt.grp.3="Group: Invisible oval"
  435. wrd=newgadget(0,"j",0,0,0,"WORDMODE")
  436. ltxt.wrd="Join words"
  437. spl=newgadget(2,"s",0,25,0,"SPIRAL",1,100)
  438. ltxt.spl.1="Spiral %: Outside > inside"
  439. ltxt.spl.2="Spiral %: Inside > outside"
  440. siz=newgadget(2,"f",0,100,0,"SIZE",1,100)
  441. ltxt.siz.1="Font size %: Decreasing"
  442. ltxt.siz.2="Font size %: Increasing"
  443. zoo=newgadget(3,"z",0,50,0,"ZOOM",1,1000)
  444. ltxt.zoo.1="Zoom %: All"
  445. ltxt.zoo.2="Zoom %: Height"
  446. ltxt.zoo.3="Zoom %: Width"
  447. ink=newgadget(-5,"i",0,0,0,"COLOUR")
  448. ltxt.ink.1="Ink: From text"
  449. ltxt.ink.2="Ink: From oval fill"
  450. ltxt.ink.3="Ink: From oval border"
  451. ltxt.ink.4="Ink: Shadow = oval fill"
  452. ltxt.ink.5="Ink: Shadow = oval border"
  453. adj=newgadget(-5,"a",0,0,0,"ADJUST")
  454. ltxt.adj.1="Adjust: Nothing"
  455. ltxt.adj.2="Adjust: Character size"
  456. ltxt.adj.3="Adjust: Character width"
  457. ltxt.adj.4="Adjust: Apparent width"
  458. ltxt.adj.5="Adjust: Arc"
  459. adjarc=5
  460. pat=newgadget(0,"p",0,0,0,"PATTERN")
  461. ltxt.pat="Pattern from selected text"
  462. xgad=newstr(7,"x",1,"",1,"XPOS")
  463. ltxt.xgad="(%m) X:"
  464. ygad=newstr(7,"y",1,"",1,"YPOS")
  465. ltxt.ygad="Y:"
  466. wgad=newstr(7,"w",1,"",1,"WIDTH")
  467. ltxt.wgad="Width:"
  468. hgad=newstr(7,"h",1,"",1,"HEIGHT")
  469. ltxt.hgad="Height:"
  470. pgad=newstr(4,"#",1,1,0,"PAGE")
  471. ltxt.pgad="# of page:"
  472. tgad=newstr(200,"t",2,"",2,"TEXT")
  473. ltxt.tgad="Text:"
  474. okgad=newbutton("  OK  ","o",RETURN,"OK")
  475. cancelgad=newbutton("Cancel","c",esc,"CANCEL")
  476. closegad=newkey(del,"CLOSE")
  477. zipgad=newkey(" ","ZIP")
  478. depthgad=newkey(bs,"BACK")
  479. mtitle="Settings"
  480. mgad=newchkitem("Gadgets are auto-activated","G",1,"ACTIVATE")
  481. mspl=newchkitem("Adjust arc for spirals","A",1,"IMPROVE")
  482. mwin=newchkitem("Window beneath pointer","W",1,"WINDOW")
  483. mscr=newchkitem("Use Final Writer's screen","U",1,"SCREEN")
  484. mrel=newchkitem("Final Writer Release 3","F",1,"RELEASE")
  485. CALL newitem("","",mnode.0)
  486. mload=newitem("Load","L","LOAD")
  487. msave=newitem("Save","S","SAVE")
  488. mres=newitem("Reset","R","RESET")
  489. mdef=newitem("Defaults","D","DEFAULTS")
  490. CALL newitem("","",mnode.0)
  491. mtext=newitem("Text block preferences","T","TEXTPREFS")
  492. moval=newitem("Oval preferences","O","OVALPREFS")
  493. CALL newitem("","",mnode.0)
  494. mnext=newitem("Next Document","N","NEXT")
  495. mrexx=newitem("Execute Arexx macro...","E","MACRO")
  496. mhelp=newitem("Help...","H","HELP")
  497. mabt=newitem("About...","?","ABOUT")
  498. fwerrtext.5="Instruction didn't succeed"
  499. fwerrtext.10="Instruction failed"
  500. fwerrtext.20="Invalid arguments"
  501. fwerrtext.100="Unknown instruction"
  502. fwerrtext.200="Couldn't open fwarexx.library"
  503. END
  504. RETURN
  505. checkenv: 
  506. about=replacepat(replacepat(about,"%v",version),"%d",date)
  507. info=replacepat(replacepat("FinalWrapper %v by NDY's","%v",version),"%d",date)
  508. origwintitle=replacepat(origwintitle,"%i",info)
  509. origscrtitle=replacepat(origscrtitle,"%i",info)
  510. wtitle=origwintitle
  511. stitle=origscrtitle
  512. busytitle=replacepat(busytitle,"%i",info)
  513. doc=""
  514. CALL newdoc
  515. menus=mchks+macts
  516. gads=agads+tgads+sgads
  517. kgads=gads+wgads
  518. menuoff=kgads
  519. i=32+menuoff
  520. mnode.i=mnode.0
  521. prefsize=agads*4+mchks+4
  522. prefsid="FW30"||D2C(prefsize,2)
  523. tempsize=0
  524. IF temp~="" THEN
  525. DO id=agads+1 TO agads+sgads
  526. tempsize=tempsize+len.id
  527. END
  528. cancelclose=cancelgad-agads
  529. okclose=okgad-agads
  530. winclose=tgads+1
  531. rxclose=winclose+1
  532. nextclose=rxclose+1
  533. DO id=1 TO kgads
  534. IF ~Datatype(lkey.id,"W") THEN lkey.id=C2D(Upper(lkey.id))
  535. END
  536. IF initerr=14 THEN
  537. DO
  538. ln=replacepat(nolib,"%y",library.libn)
  539. CALL message(14,ln)
  540. CALL bye(14)
  541. END
  542. execbase=GETVALUE("4"x,0,4,"P")
  543. osversion=GETVALUE(execbase,20,2,"N")
  544. IF osversion<37 THEN CALL message(10,wrongos)
  545. IF ~xexists(fwkey) THEN fwkey=""
  546. IF help THEN
  547. DO
  548. docfile="HELP:"||language||"/"||docname
  549. IF ~xexists(docfile) THEN
  550. DO
  551. docfile="ENVARC:FinalWrapper/"||docname
  552. IF ~xexists(docfile) THEN help=0
  553. END
  554. END
  555. RETURN
  556. guiinit: 
  557. IF cleangui THEN RETURN 0
  558. pubscr=Null() ; scr=Null() ; win=Null() ; gad=Null() ; scrvinfo=Null() ; menu=Null() ; port=0
  559. cleangui=1
  560. CALL SET_APIG_GLOBALS()
  561. GT_TAGBASE=X2D("80080000")
  562. GTMN_NEWLOOKMENUS=X2C("80080043")
  563. GTCB_SCALED=X2C("80080044")
  564. WA_NEWLOOKMENUS=X2C("80000093")
  565. nullbyte=D2C(0)
  566. port=OpenPort(portname)
  567. IF ~port THEN RETURN 5
  568. pubscr=LockPubScreen("")
  569. IF pubscr=Null() THEN RETURN 5
  570. IF pubonly THEN
  571. scr=pubscr
  572. ELSE
  573. scr=customscr
  574. scrvinfo=GetVisualInfo(scr)
  575. IF scrvinfo=Null() THEN RETURN 5
  576. scrfont=GETVALUE(scr,40,4,"P")
  577. fonth=GETVALUE(scrfont,4,2,"N")
  578. scrrp=D2C(C2D(scr)+84)
  579. glistptr=MAKEPOINTER(0,0,4,MEMF_CLEAR)
  580. IF glistptr=Null() THEN RETURN 5
  581. borderl=GETVALUE(scr,36,1,"N")
  582. borderr=GETVALUE(scr,37,1,"N")
  583. bordert=GETVALUE(scr,35,1,"N")+fonth+1
  584. pubname=""
  585. pubnptr=MAKEPOINTER(0,0,MAXPUBSCREENNAME,MEMF_CLEAR)
  586. IF pubnptr~=Null() THEN
  587. DO
  588. checkscr=GetDefaultPubScreen(pubnptr)
  589. IF checkscr=pubscr THEN pubname=Import(pubnptr)
  590. CALL FREETHIS(pubnptr)
  591. END
  592. IF pubname="" THEN
  593. DO
  594. pubname="Workbench"
  595. usewb=1
  596. END
  597. ELSE
  598. usewb=0
  599. rows=2
  600. gadh=fonth+4
  601. gaddy=gadh+2
  602. DO i=1 TO 3+slines
  603. maxwidth.i=0
  604. END
  605. charw=TextLength(scrrp,"W"||nullbyte,-1) 
  606. intw=charw*4+12   
  607. strminw=charw*2+6
  608. addwidth=30+intw
  609. gperrow=agads%rows+agads//rows
  610. DO id=1 TO agads
  611. k=1+(id>gperrow)
  612. IF labs.id=0 THEN
  613. DO
  614. gwid.id=TextLength(scrrp,ltxt.id||nullbyte,-1)+34
  615. maxwidth.k=Max(maxwidth.k,gwid.id)
  616. END
  617. ELSE
  618. DO
  619. glabels.id=MAKEPOINTER(0,0,4*Abs(labs.id)+4,MEMF_CLEAR)
  620. IF glabels.id=Null() THEN RETURN 5
  621. DO i=1 TO Abs(labs.id) 
  622. lbuf.id.i=MAKEPOINTER(glabels.id,0,Length(ltxt.id.i)+1,MEMF_CLEAR)
  623. IF lbuf.id.i=Null() THEN RETURN 5
  624. CALL Export(lbuf.id.i,ltxt.id.i)
  625. CALL SETVALUE(glabels.id,(i-1)*4,4,"P",lbuf.id.i)
  626. xwid=TextLength(scrrp,ltxt.id.i||nullbyte,-1)+30
  627. IF labs.id>0 THEN xwid=xwid+addwidth
  628. maxwidth.k=Max(maxwidth.k,xwid)
  629. END
  630. END
  631. END
  632. DO i=1 TO slines
  633. nsgads.i=0
  634. END
  635. DO id=agads+1 TO agads+sgads
  636. gwid.id=TextLength(scrrp,ltxt.id||nullbyte,-1)
  637. lin=line.id
  638. maxnr=3+lin
  639. maxwidth.maxnr=maxwidth.maxnr+gwid.id+strminw+12
  640. nsgads.lin=nsgads.lin+1
  641. END
  642. DO id=agads+sgads+1 TO gads
  643. gwid.id=TextLength(scrrp,ltxt.id||nullbyte,-1)+6
  644. maxwidth.3=maxwidth.3+gwid.id+2
  645. END
  646. maxwidth=Max((Max(maxwidth.1,maxwidth.2)+4)*rows-4,maxwidth.3)
  647. DO i=4 TO slines+3
  648. maxwidth=Max(maxwidth,maxwidth.i)
  649. END
  650. winwid=maxwidth+4
  651. winhi=(gperrow+1+slines)*gaddy+6
  652. gadx=borderl+2
  653. gady=bordert+1
  654. gadw=maxwidth%rows-rows*2+2
  655. gadmaxx=winwid+borderl-2
  656. gadmaxy=winhi+bordert-1
  657. id=0
  658. gx=gadx
  659. cyx=gx
  660. chkx=gx+gadw-26
  661. intx=gx+gadw-28-intw
  662. textplace=PLACETEXT_LEFT
  663. DO i=0 TO 1
  664. DO j=0 TO gperrow-1 WHILE id<agads
  665. id=i*gperrow+j+1
  666. gadid=id*3
  667. IF labs.id>0 THEN
  668. DO
  669. newgadx.id=MAKENEWGADGET(scrvinfo,scrfont,gx,gady+j*gaddy,gadw-addwidth,gadh,"",0,gadid,Null())
  670. newgadxb.id=MAKENEWGADGET(scrvinfo,scrfont,chkx,gady+j*gaddy,26,gadh,"",0,gadid+1,Null())
  671. newgadxi.id=MAKENEWGADGET(scrvinfo,scrfont,intx,gady+j*gaddy,intw,gadh,"",0,gadid+2,Null())
  672. IF newgadxb.id=Null() | newgadxi.id=Null() | newgadx.id=Null() THEN RETURN 5
  673. END
  674. ELSE
  675. DO
  676. IF labs.id<0 THEN
  677. newgadx.id=MAKENEWGADGET(scrvinfo,scrfont,cyx,gady+j*gaddy,gadw,gadh,"",0,id*3,Null())
  678. ELSE
  679. newgadx.id=MAKENEWGADGET(scrvinfo,scrfont,chkx,gady+j*gaddy,26,gadh,ltxt.id,textplace,id*3+1,Null())
  680. IF newgadx.id=Null() THEN RETURN 5
  681. END
  682. END
  683. chkx=gadmaxx-gadw
  684. intx=chkx+28
  685. gx=chkx+addwidth
  686. cyx=chkx
  687. textplace=PLACETEXT_RIGHT
  688. END
  689. gy=gady+gaddy*gperrow
  690. DO i=1 TO slines
  691. gx=gadx
  692. maxnr=i+3
  693. strw=(maxwidth-maxwidth.maxnr)%(nsgads.i)+strminw
  694. DO id=agads+1 TO agads+sgads
  695. IF line.id=i THEN
  696. DO
  697. nsgads.i=nsgads.i-1
  698. IF nsgads.i=0 THEN strw=gadmaxx-(gx+gwid.id+8)
  699. newgadx.id=MAKENEWGADGET(scrvinfo,scrfont,gx+gwid.id+8,gy,strw,gadh,ltxt.id,PLACETEXT_LEFT,id*3+2,Null())
  700. gx=gx+gwid.id+strw+12
  701. IF newgadx.id=Null() THEN RETURN 5
  702. END
  703. END
  704. gy=gy+gaddy
  705. END
  706. gx=gadx+(maxwidth-maxwidth.3)%2
  707. DO id=agads+sgads+1 TO gads
  708. newgadx.id=MAKENEWGADGET(scrvinfo,scrfont,gx,gadmaxy-gadh,gwid.id,gadh,ltxt.id,PLACETEXT_IN,id*3,Null())
  709. gx=gx+gwid.id+4
  710. IF newgadx.id=Null() THEN RETURN 5
  711. END
  712. newgadbv=MAKENEWGADGET(scrvinfo,scrfont,gadx,gadmaxy-gadh-5,maxwidth,2,0,0,Null())
  713. gad=CreateContext(glistptr)
  714. prev=gad
  715. DO id=1 TO gads
  716. IF id>agads THEN
  717. IF id>agads+sgads THEN
  718. DO
  719. checkgad.id=CreateGadget(BUTTON_KIND,prev,newgadx.id,TAG_DONE,0)
  720. prev=checkgad.id
  721. END
  722. ELSE
  723. DO
  724. IF gtype.id=0 THEN
  725. intgad.id=CreateGadget(INTEGER_KIND,prev,newgadx.id,GTIN_NUMBER,val.id,GTIN_MAXCHARS,len.id,STRINGA_EXITHELP,1,TAG_DONE,0)
  726. ELSE
  727. intgad.id=CreateGadget(STRING_KIND,prev,newgadx.id,GTST_STRING,val.id,GTST_MAXCHARS,len.id,STRINGA_EXITHELP,1,TAG_DONE,0)
  728. prev=intgad.id
  729. END
  730. ELSE
  731. IF labs.id=0 THEN
  732. DO
  733. checkgad.id=CreateGadget(CHECKBOX_KIND,prev,newgadx.id,GTCB_CHECKED,check.id,GTCB_SCALED,-1,TAG_DONE,0)
  734. prev=checkgad.id
  735. END
  736. ELSE
  737. IF labs.id>0 THEN
  738. DO
  739. checkgad.id=CreateGadget(CHECKBOX_KIND,prev,newgadxb.id,GTCB_CHECKED,check.id,GTCB_SCALED,-1,TAG_DONE,0)
  740. intgad.id=CreateGadget(INTEGER_KIND,checkgad.id,newgadxi.id,GTIN_NUMBER,val.id,GTIN_MAXCHARS,4,STRINGA_EXITHELP,1,TAG_DONE,0)
  741. cyclegad.id=CreateGadget(CYCLE_KIND,intgad.id,newgadx.id,GTCY_LABELS,glabels.id,GTCY_ACTIVE,cycle.id,TAG_DONE,0)
  742. prev=cyclegad.id
  743. END
  744. ELSE
  745. DO
  746. cyclegad.id=CreateGadget(CYCLE_KIND,prev,newgadx.id,GTCY_LABELS,glabels.id,GTCY_ACTIVE,cycle.id,TAG_DONE,0)
  747. prev=cyclegad.id
  748. END
  749. END
  750. prev=CreateGadget(TEXT_KIND,prev,newgadbv,GTTX_BORDER,-1,TAG_DONE,0)
  751. IF prev=Null() THEN RETURN 5 
  752. mptr=MAKENEWMENU(menus)
  753. IF mptr=Null() THEN RETURN 5
  754. CALL ADDTO_NEWMENU(mptr,NM_TITLE,mtitle,"",0,0,Null())
  755. DO i=1 TO menus
  756. n=menuoff+i
  757. IF ltxt.n="" THEN
  758. mtxt=NM_BARLABEL
  759. ELSE
  760. mtxt=ltxt.n
  761. IF i>mchks THEN
  762. flags=MENUTOGGLE
  763. ELSE
  764. flags=CHECKED*check.n+CHECKIT+MENUTOGGLE
  765. IF Length(mkey.n)~=1 THEN mkey.n=""
  766. CALL ADDTO_NEWMENU(mptr,NM_ITEM,mtxt,mkey.n,flags,0,Null())
  767. END
  768. DROP ltxt
  769. CALL ADDTO_NEWMENU(mptr,NM_END,"","",0,0,Null())
  770. menu=CreateMenus(mptr,TAG_DONE,0)
  771. IF menu=Null() THEN RETURN 5
  772. IF LayoutMenus(menu,scrvinfo,GTMN_NEWLOOKMENUS,-1,TAG_DONE,0)=0 THEN RETURN 5
  773. winidcmp=IDCMP_CHANGEWINDOW+IDCMP_CLOSEWINDOW+IDCMP_GADGETUP+IDCMP_ACTIVEWINDOW+IDCMP_MOUSEBUTTONS+IDCMP_MENUPICK+IDCMP_VANILLAKEY+IDCMP_RAWKEY+IDCMP_MENUHELP
  774. winflags=WFLG_CLOSEGADGET+WFLG_DEPTHGADGET+WFLG_DRAGBAR+WFLG_ACTIVATE
  775. IF check.mwin THEN
  776. DO
  777. ymouse=GETVALUE(scr,16,2,"N")
  778. xmouse=GETVALUE(scr,18,2,"N")
  779. END
  780. ELSE
  781. DO
  782. ymouse=winx+winhi/2
  783. xmouse=winy+winwid/2
  784. END
  785. wtagl=MAKEPOINTER(0,0,104+8,MEMF_CLEAR)
  786. IF wtagl=Null() THEN RETURN 5
  787. wname=MAKEPOINTER(wtagl,0,Length(wintitle)+1,MEMF_CLEAR)
  788. IF wname=Null() THEN RETURN 5
  789. CALL Export(wname,wintitle)
  790. sname=MAKEPOINTER(wtagl,0,Length(scrtitle)+1,MEMF_CLEAR)
  791. IF sname=Null() THEN RETURN 5
  792. CALL Export(sname,scrtitle)
  793. wzipdims=MAKEPOINTER(wtagl,0,8,MEMF_CLEAR)
  794. IF wzipdims=Null() THEN RETURN 5
  795. zipwid=winwid+borderl+borderr
  796. ziphi=bordert
  797. CALL SETVALUE(wzipdims,4,2,"N",zipwid)
  798. CALL SETVALUE(wzipdims,6,2,"N",ziphi)
  799. CALL SETTAGSLOT(wtagl,0,WA_LEFT,"N",Max(xmouse-winwid/2,0))
  800. CALL SETTAGSLOT(wtagl,1,WA_TOP,"N",Max(ymouse-winhi/2,0))
  801. CALL SETTAGSLOT(wtagl,2,WA_INNERWIDTH,"N",winwid)
  802. CALL SETTAGSLOT(wtagl,3,WA_INNERHEIGHT,"N",winhi)
  803. CALL SETTAGSLOT(wtagl,4,WA_IDCMP,"N",winidcmp)
  804. CALL SETTAGSLOT(wtagl,5,WA_FLAGS,"N",winflags)
  805. CALL SETTAGSLOT(wtagl,6,WA_TITLE,"P",wname)
  806. CALL SETTAGSLOT(wtagl,7,WA_SCREENTITLE,"P",sname)
  807. CALL SETTAGSLOT(wtagl,8,WA_GADGETS,"P",gad)
  808. IF pubonly THEN
  809. CALL SETTAGSLOT(wtagl,9,WA_PUBSCREEN,"P",scr)
  810. ELSE
  811. CALL SETTAGSLOT(wtagl,9,WA_CUSTOMSCREEN,"P",scr)
  812. CALL SETTAGSLOT(wtagl,10,WA_ZOOM,"P",wzipdims)
  813. CALL SETTAGSLOT(wtagl,11,WA_NEWLOOKMENUS,"N",-1)
  814. CALL SETTAGSLOT(wtagl,12,WA_MENUHELP,"N",-1)
  815. CALL SETTAGSLOT(wtagl,13,TAG_DONE,"N",0)
  816. win=OpenWindowTagList(portname,Null(),wtagl,0)
  817. IF win=Null() THEN RETURN 5
  818. rp=GETWINDOWRASTPORT(win)
  819. dwid=GETVALUE(win,8,2,"N")-zipwid
  820. dhi=GETVALUE(win,10,2,"N")-ziphi
  821. CALL GT_RefreshWindow(win,Null())
  822. CALL SetMenuStrip(win,menu)
  823. zoomed=1
  824. RETURN 0
  825. messy: 
  826. IF port=0 THEN RETURN
  827. DO FOREVER
  828. msg=GetPkt(portname)
  829. IF msg=Null() THEN LEAVE
  830. msgclass=GetArg(msg,0)
  831. zipped=GETVALUE(win,10,2,"N")=ziphi
  832. IF ~Datatype(msgclass,"W") THEN
  833. CALL rx
  834. ELSE
  835. DO
  836. code=GetArg(msg,1)
  837. qual=GetArg(msg,2)
  838. gadid=GetArg(msg,9)
  839. CALL Reply(msg,0)
  840. END
  841. actgads=check.mgad & ~zipped
  842. nospiral=~check.spl
  843. IF msgclass=IDCMP_VANILLAKEY THEN
  844. DO
  845. code=C2D(Upper(D2C(code)))
  846. DO id=1 TO kgads
  847. IF code=lkey.id | code=lkey2.id THEN
  848. DO
  849. IF id=zipgad THEN
  850. DO
  851. CALL ZipWindow(win)
  852. LEAVE
  853. END
  854. ELSE
  855. IF id=depthgad THEN
  856. DO
  857. windowpos=~windowpos
  858. IF windowpos THEN
  859. CALL WindowToBack(win)
  860. ELSE
  861. CALL WindowToFront(win)
  862. LEAVE
  863. END
  864. ELSE
  865. IF id>agads+sgads THEN
  866. DO
  867. closed=id-agads
  868. LEAVE
  869. END
  870. IF ~zipped THEN
  871. DO
  872. msgclass=IDCMP_GADGETUP
  873. type=(qual//4)//3
  874. IF labs.id=0 THEN type=1
  875. IF labs.id<0 THEN type=0
  876. IF id>agads THEN type=2
  877. gadid=id*3+type
  878. IF type=2 | (actgads & ~(check.id & type=1)) THEN CALL ActivateGadget(intgad.id,win,Null())
  879. IF type=1 THEN code=~check.id
  880. IF labs.id>=0 & type=1 THEN CALL GT_SetGadgetAttrs(checkgad.id,win,Null(),GTCB_CHECKED,code)
  881. IF type=0 THEN code=(cycle.id+1)//Abs(labs.id)
  882. IF labs.id~=0 & type=0 THEN CALL GT_SetGadgetAttrs(cyclegad.id,win,Null(),GTCY_ACTIVE,code)
  883. LEAVE
  884. END
  885. END
  886. END
  887. END
  888. SELECT
  889. WHEN msgclass=IDCMP_CLOSEWINDOW THEN closed=winclose
  890. WHEN msgclass=IDCMP_MENUPICK THEN
  891. DO
  892. mnr=(code%32)//32+1
  893. n=menuoff+mnr
  894. IF mnr<=mchks THEN check.n=~check.n
  895. SELECT
  896. WHEN n=mload THEN
  897. CALL loaddef(2)
  898. WHEN n=msave THEN
  899. CALL savedef(2)
  900. WHEN n=mres THEN
  901. CALL loaddef(1)
  902. WHEN n=mdef THEN
  903. CALL loaddef(0)
  904. WHEN n=mabt THEN
  905. CALL message(0,about)
  906. WHEN n=mtext THEN
  907. IF portok THEN
  908. DO
  909. resume="BACKMESSY"
  910. errtrap=10
  911. TextBlockPrefs "PROMPT"
  912. END
  913. WHEN n=moval THEN
  914. IF portok THEN
  915. DO
  916. resume="BACKMESSY"
  917. errtrap=10
  918. OvalPrefs "PROMPT"
  919. END
  920. WHEN n=mnext THEN
  921. DO
  922. x=SubStr(rxport,Length(finalw)+1)
  923. i=x
  924. DO UNTIL Show("P",rxport) | i=x
  925. i=i//20+1
  926. rxport=finalw||i
  927. END
  928. IF x~=i THEN closed=nextclose
  929. END
  930. WHEN n=mrexx THEN
  931. IF lib.reqtools THEN
  932. DO
  933. i=Max(Pos(defdir,':'),LastPos('/',defdir))
  934. resume="BACKMESSY"
  935. errtrap=14
  936. newdir=RTFileRequest(SubStr(defdir,1,i),DelStr(defdir,1,i),rxfilerq,rxfileok,"RT_SCREENTOFRONT=TRUE")
  937. IF newdir~="" THEN
  938. DO
  939. defdir=newdir
  940. IF xexists("ENV:FinalWrapper") THEN 
  941. IF Open(prefs,"ENV:FinalWrapper/FWPath","W") THEN
  942. DO
  943. CALL WriteLn(prefs,defdir)
  944. CALL Close(prefs)
  945. END
  946. closed=rxclose
  947. END
  948. END
  949. WHEN n=mhelp THEN
  950. IF help THEN
  951. DO
  952. IF usewb THEN
  953. CALL WBenchToFront()
  954. ELSE
  955. CALL ScreenToFront(pubscr)
  956. CALL Shownode(pubname,docfile,"MAIN",1,0)
  957. CALL ScreenToFront(scr)
  958. END
  959. ELSE
  960. CALL message(0,nohelp)
  961. OTHERWISE NOP
  962. END
  963. END
  964. WHEN actgads & (msgclass=IDCMP_ACTIVEWINDOW | msgclass=IDCMP_MOUSEBUTTONS) THEN CALL ActivateGadget(intgad.1,win,Null())
  965. WHEN msgclass=IDCMP_MENUHELP | (code=95 & (msgclass=IDCMP_RAWKEY | msgclass=IDCMP_GADGETUP)) THEN
  966. IF help THEN
  967. DO
  968. IF usewb THEN
  969. CALL WBenchToFront()
  970. ELSE
  971. CALL ScreenToFront(pubscr)
  972. mnr=(code%32)//32+1+menuoff
  973. IF msgclass=IDCMP_MENUHELP THEN
  974. node=mnode.mnr
  975. ELSE
  976. IF zipped THEN
  977. node=gnode.0
  978. ELSE 
  979. DO
  980. ymouse=getshort(C2D(win),12)
  981. xmouse=getshort(C2D(win),14)
  982. gad=GETVALUE(win,62,4,"P")
  983. id=0
  984. IF xmouse>=0 & ymouse>=0 & xmouse<dwid+zipwid & ymouse<dhi+ziphi & gad~=Null() THEN
  985. DO UNTIL gad=Null()
  986. x=getshort(C2D(gad),4)
  987. y=getshort(C2D(gad),6)
  988. w=getshort(C2D(gad),8)
  989. h=getshort(C2D(gad),10)
  990. i=GETVALUE(gad,38,2,"N")
  991. IF xmouse>=x & xmouse<=x+w & ymouse>=y & ymouse<=y+h & i>0 THEN
  992. DO
  993. id=i%3
  994. LEAVE
  995. END
  996. ELSE
  997. gad=GETVALUE(gad,0,4,"P")
  998. END
  999. node=gnode.id
  1000. END
  1001. CALL Shownode(pubname,docfile,node,1,0)
  1002. CALL ScreenToFront(scr)
  1003. END
  1004. ELSE
  1005. CALL message(0,nohelp)
  1006. WHEN msgclass=IDCMP_GADGETUP THEN
  1007. DO
  1008. type=gadid//3
  1009. id=gadid%3
  1010. SELECT
  1011. WHEN id>agads+sgads THEN closed=id-agads 
  1012. WHEN type=2 THEN CALL checkstrgad 
  1013. WHEN type=1 THEN  
  1014. DO
  1015. check.id=code
  1016. IF labs.id>0 & check.id~=0 & actgads THEN CALL ActivateGadget(intgad.id,win,Null())
  1017. END
  1018. OTHERWISE 
  1019. DO
  1020. cycle.id=code
  1021. check.id=1
  1022. IF labs.id>0 THEN CALL GT_SetGadgetAttrs(checkgad.id,win,Null(),GTCB_CHECKED,check.id)
  1023. IF labs.id>0 & actgads THEN CALL ActivateGadget(intgad.id,win,Null())
  1024. END
  1025. END
  1026. END
  1027. OTHERWISE NOP
  1028. END
  1029. IF check.mspl THEN
  1030. IF check.spl & nospiral THEN 
  1031. DO
  1032. cycle.adj=adjarc-1
  1033. CALL GT_SetGadgetAttrs(cyclegad.adj,win,Null(),GTCY_ACTIVE,cycle.adj)
  1034. END
  1035. END
  1036. BACKMESSY:
  1037. IF trapped THEN
  1038. DO
  1039. trapped=0
  1040. IF err=14 THEN
  1041. DO
  1042. lib.reqtools=0
  1043. CALL message(0,noreqtools)
  1044. END
  1045. END
  1046. RETURN
  1047. checkstrgad: 
  1048. old=val.id
  1049. specialinfo=GETVALUE(intgad.id,34,4,"P")
  1050. IF id>agads THEN
  1051. DO
  1052. IF gtype.id=0 THEN
  1053. val.id=GETVALUE(specialinfo,28,4,"N")
  1054. ELSE
  1055. DO
  1056. gval=GETVALUE(specialinfo,0,4,"S")
  1057. IF gtype.id=1 & gval~=old THEN
  1058. DO
  1059. IF gval~="" THEN
  1060. IF ~Datatype(replacepat(gval,",","."),"N") THEN
  1061. DO
  1062. IF closed=okclose THEN closed=0
  1063. IF closed=0 THEN CALL message(0,replacepat(notnum,"%g",ltxt.id))
  1064. END
  1065. ELSE
  1066. IF deci="COMMA" THEN
  1067. val.id=replacepat(Max(replacepat(gval,",","."),0),".",",")
  1068. ELSE
  1069. val.id=Max(replacepat(gval,",","."),0)
  1070. ELSE
  1071. val.id=""
  1072. IF val.id~=gval THEN CALL GT_SetGadgetAttrs(intgad.id,win,Null(),GTST_STRING,val.id)
  1073. END
  1074. ELSE
  1075. IF gtype.id=2 THEN val.id=gval
  1076. END
  1077. END
  1078. ELSE
  1079. DO
  1080. gval=GETVALUE(specialinfo,28,4,"N")
  1081. val.id=Max(Min(ubound.id,gval),lbound.id)
  1082. IF val.id~=gval THEN CALL GT_SetGadgetAttrs(intgad.id,win,Null(),GTIN_NUMBER,val.id)
  1083. check.id=check.id | (old~=val.id & actgads)
  1084. IF old~=val.id | actgads THEN CALL GT_SetGadgetAttrs(checkgad.id,win,Null(),GTCB_CHECKED,check.id)
  1085. END
  1086. RETURN
  1087. rx: 
  1088. PARSE VAR msgclass comm ar.1 ar.2 ar.3
  1089. arg1=Upper(ar.1)
  1090. arg2=SubStr(msgclass,Pos(ar.1,msgclass,Length(comm)+1)+Length(ar.1)+1)
  1091. IF Datatype(arg1,"U") THEN INTERPRET "id="||arg1
  1092. comm=Upper(comm)
  1093. full=msgclass
  1094. msgclass=0
  1095. ret=0
  1096. res=0
  1097. SELECT
  1098. WHEN comm="SETVAL" THEN
  1099. IF checksyntax("W") & ar.2~="" THEN
  1100. SELECT
  1101. WHEN id>0 & id<=agads THEN
  1102. IF labs.id>0 & Datatype(ar.2,"W") THEN
  1103. DO
  1104. gadid=id*3+2
  1105. msgclass=IDCMP_GADGETUP
  1106. code=0
  1107. CALL GT_SetGadgetAttrs(intgad.id,win,Null(),GTIN_NUMBER,ar.2)
  1108. res=val.id
  1109. END
  1110. WHEN id>agads & id<=agads+sgads THEN
  1111. IF Datatype(replacepat(ar.2,",","."),Word("W N A",gtype.id+1)) | gtype.id=2 THEN
  1112. DO
  1113. gadid=id*3+2
  1114. msgclass=IDCMP_GADGETUP
  1115. code=0
  1116. IF gtype.id=2 THEN
  1117. CALL GT_SetGadgetAttrs(intgad.id,win,Null(),GTST_STRING,arg2)
  1118. ELSE
  1119. IF gtype.id=1 THEN
  1120. CALL GT_SetGadgetAttrs(intgad.id,win,Null(),GTST_STRING,ar.2)
  1121. ELSE
  1122. CALL GT_SetGadgetAttrs(intgad.id,win,Null(),GTIN_NUMBER,ar.2)
  1123. res=val.id
  1124. END
  1125. OTHERWISE NOP
  1126. END
  1127. WHEN comm="SETMODE" THEN
  1128. IF checksyntax("W","w") &  id>0 & id<=agads & labs.id~=0 THEN
  1129. DO
  1130. gadid=id*3
  1131. msgclass=IDCMP_GADGETUP
  1132. code=ar.2
  1133. CALL GT_SetGadgetAttrs(cyclegad.id,win,Null(),GTCY_ACTIVE,code)
  1134. res=cycle.id
  1135. END
  1136. WHEN comm="SETSTATE" THEN
  1137. IF checksyntax("W","w") THEN
  1138. IF id>0 & id<=agads & labs.id>=0 THEN
  1139. DO
  1140. gadid=id*3+1
  1141. msgclass=IDCMP_GADGETUP
  1142. code=(ar.2~=0)
  1143. CALL GT_SetGadgetAttrs(checkgad.id,win,Null(),GTCB_CHECKED,code)
  1144. res=check.id
  1145. END
  1146. ELSE
  1147. IF id>menuoff & id<=menuoff+mchks THEN
  1148. DO
  1149. check.id=(ar.2~=0)
  1150. CALL ClearMenuStrip(win)
  1151. item=GETVALUE(menu,18,4,"P")
  1152. DO n=menuoff+1 TO id-1
  1153. item=GETVALUE(item,0,4,"P")
  1154. END
  1155. flags=C2D(B2C(BitAnd(C2B(D2C(GETVALUE(item,12,2,"N"),2)),"1111111011111111")))+CHECKED*check.id
  1156. CALL SETVALUE(item,12,2,"N",flags,0)
  1157. CALL ResetMenuStrip(win,menu)
  1158. msgclass=-1
  1159. END
  1160. WHEN comm="GETVAL" THEN
  1161. IF checksyntax("W") & id>0 & ((id<=agads & labs.id>0) | id<=agads+sgads) THEN
  1162. DO
  1163. specialinfo=GETVALUE(intgad.id,34,4,"P")
  1164. IF id>agads & gtype.id~=0 THEN
  1165. DO
  1166. val=GETVALUE(specialinfo,0,4,"S")
  1167. IF gtype.id=1 THEN val=replacepat(val,",",".")
  1168. END
  1169. ELSE
  1170. val=GETVALUE(specialinfo,28,4,"N")
  1171. res=val
  1172. msgclass=-1
  1173. END
  1174. WHEN comm="GETMODE" THEN
  1175. IF checksyntax("W") & id>0 & id<=agads THEN
  1176. DO
  1177. res=cycle.id
  1178. msgclass=-1
  1179. END
  1180. WHEN comm="GETSTATE" THEN
  1181. IF checksyntax("W") & ((id>0 & id<=agads & labs.id>=0) | (id>menuoff & id<=menuoff+mchks)) THEN
  1182. DO
  1183. res=check.id
  1184. msgclass=-1
  1185. END
  1186. WHEN comm="USE" THEN
  1187. IF checksyntax("W") THEN
  1188. IF id>=agads+sgads & id<=kgads THEN
  1189. DO
  1190. msgclass=-1
  1191. IF id=zipgad THEN
  1192. CALL ZipWindow(win)
  1193. ELSE
  1194. IF id=depthgad THEN
  1195. DO
  1196. windowpos=~windowpos
  1197. IF windowpos THEN
  1198. CALL WindowToBack(win)
  1199. ELSE
  1200. CALL WindowToFront(win)
  1201. END
  1202. ELSE
  1203. DO
  1204. msgclass=IDCMP_GADGETUP
  1205. code=0
  1206. gadid=id*3
  1207. END
  1208. END
  1209. ELSE
  1210. IF id>menuoff+mchks & id<=menuoff+mchks+macts THEN
  1211. DO
  1212. msgclass=IDCMP_MENUPICK
  1213. code=(id-1-menuoff)*32
  1214. END
  1215. WHEN comm="SET" THEN
  1216. DO
  1217. msgclass=-1
  1218. SELECT
  1219. WHEN Abbrev("PORT",arg1,1) THEN
  1220. DO
  1221. IF Show("P",ar.2) & Left(ar.2,Length(finalw))=finalw THEN rxport=ar.2
  1222. res=rxport
  1223. END
  1224. WHEN Abbrev("SCREEN",arg1,1) THEN
  1225. DO
  1226. IF arg2="" THEN
  1227. stitle=origscrtitle
  1228. ELSE
  1229. stitle=arg2
  1230. scrtitle=replacepat(replacepat(stitle,"%f",doc),"%i",info)
  1231. CALL SetWindowTitles(win,wintitle,scrtitle)
  1232. END
  1233. WHEN Abbrev("WINDOW",arg1,1) THEN
  1234. DO
  1235. IF arg2="" THEN
  1236. wtitle=origwintitle
  1237. ELSE
  1238. wtitle=arg2
  1239. wintitle=replacepat(replacepat(wtitle,"%f",doc),"%i",info)
  1240. CALL SetWindowTitles(win,wintitle,scrtitle)
  1241. END
  1242. WHEN Abbrev("ZIP",arg1,1) THEN
  1243. DO
  1244. res=zipped
  1245. zipped=(ar.2~=0)
  1246. IF zipped~=res THEN CALL ZipWindow(win)
  1247. END
  1248. OTHERWISE msgclass=0
  1249. END
  1250. END
  1251. WHEN comm="GET" THEN
  1252. DO
  1253. msgclass=-1
  1254. SELECT
  1255. WHEN Abbrev("PORT",arg1,1) THEN
  1256. IF portok THEN
  1257. res=rxport
  1258. ELSE
  1259. res=""
  1260. WHEN Abbrev("REQTOOLS",arg1,1) THEN res=lib.reqtools
  1261. WHEN Abbrev("SCREEN",arg1,1) THEN res=scrtitle
  1262. WHEN Abbrev("VERSION",arg1,1) THEN res=version
  1263. WHEN Abbrev("WINDOW",arg1,1) THEN res=wintitle
  1264. WHEN Abbrev("ZIP",arg1,1) THEN res=zipped
  1265. OTHERWISE msgclass=0
  1266. END
  1267. END
  1268. WHEN comm="PREFS" THEN
  1269. DO
  1270. msgclass=-1
  1271. IF Abbrev("STORE",arg1,1) THEN
  1272. DO
  1273. CALL savedef(1)
  1274. prefsstore=0
  1275. END
  1276. ELSE
  1277. IF Abbrev("RESET",arg1,1) THEN
  1278. DO
  1279. CALL loaddef(1)
  1280. prefsstore=1
  1281. END
  1282. ELSE
  1283. CALL loaddef(0)
  1284. END
  1285. WHEN comm="POPFRONT" THEN
  1286. DO
  1287. IF zipped THEN CALL ZipWindow(win)
  1288. CALL WindowToFront(win)
  1289. CALL ScreenToFront(scr)
  1290. CALL ActivateWindow(win)
  1291. msgclass=-1
  1292. END
  1293. WHEN comm="DIE" THEN
  1294. DO
  1295. msgclass=-1
  1296. res=lockcnt
  1297. IF lockcnt=0 THEN
  1298. DO
  1299. CALL Reply(msg,0)
  1300. IF ar.1~="" & Datatype(ar.1,"W") THEN
  1301. IF ar.2~="" THEN
  1302. DO
  1303. CALL message(ar.1,replacepat(ar.2,"_"," "),replacepat(ar.3,"_"," "))
  1304. IF ar.1=0 THEN CALL bye(0)
  1305. END
  1306. ELSE
  1307. CALL bye(ar.1)
  1308. ELSE
  1309. CALL bye(0)
  1310. END
  1311. END
  1312. WHEN comm="MESSAGE" THEN
  1313. DO
  1314. msgclass=-1
  1315. res=message(0,replacepat(ar.1,"_"," "),replacepat(ar.2,"_"," "),replacepat(ar.3,"_"," "))
  1316. END
  1317. WHEN comm="LOCK" THEN
  1318. DO
  1319. msgclass=-1
  1320. IF Abbrev("ON",arg1,2) THEN
  1321. lockcnt=lockcnt+1
  1322. ELSE
  1323. IF Abbrev("OFF",arg1,2) THEN
  1324. lockcnt=Max(0,lockcnt-1)
  1325. ELSE
  1326. IF Abbrev("RESET",arg1,1) THEN
  1327. lockcnt=0
  1328. res=lockcnt
  1329. END
  1330. WHEN comm="ABORT" THEN
  1331. msgclass=-1
  1332. WHEN comm="GO" THEN
  1333. DO
  1334. msgclass=IDCMP_GADGETUP
  1335. code=0
  1336. gadid=okgad*3
  1337. replymsg=msg
  1338. stilltoreply=1
  1339. RETURN
  1340. END
  1341. OTHERWISE NOP
  1342. END
  1343. IF msgclass=0 THEN 
  1344. CALL Reply(msg,5)
  1345. ELSE
  1346. CALL Reply(msg,ret,res)
  1347. IF msgclass=0 THEN CALL message(0,replacepat(rxcmderr,"%c",full))
  1348. RETURN
  1349. quickmessy: 
  1350. IF port=0 THEN RETURN 0
  1351. DO FOREVER
  1352. msg=GetPkt(portname)
  1353. IF msg=Null() THEN LEAVE
  1354. msgclass=GetArg(msg,0)
  1355. IF msgclass=IDCMP_CLOSEWINDOW THEN
  1356. closed=winclose
  1357. ELSE
  1358. IF msgclass=IDCMP_CHANGEWINDOW THEN
  1359. IF ~BitTst(D2C(GETVALUE(win,24,4,"N")),28) THEN CALL ZipWindow(win) 
  1360. IF Datatype(msgclass,"W") THEN
  1361. CALL Reply(msg,0)
  1362. ELSE
  1363. IF Upper(msgclass)="ABORT" THEN
  1364. DO
  1365. closed=winclose
  1366. CALL Reply(msg,0)
  1367. END
  1368. ELSE
  1369. CALL Reply(msg,1)
  1370. END
  1371. RETURN closed~=0
  1372. guiclean: 
  1373. IF cleangui THEN
  1374. DO
  1375. IF pubscr~=Null() THEN CALL UnLockPubScreen(Null(),pubscr)
  1376. IF menu~=Null() THEN CALL ClearMenuStrip(win)
  1377. IF win~=Null() THEN CALL CloseWindow(win)
  1378. IF menu~=Null() THEN CALL FreeMenus(menu)
  1379. IF gad~=Null() THEN CALL FreeGadgets(gad)
  1380. IF scrvinfo~=Null() THEN CALL FreeVisualInfo(scrvinfo)
  1381. IF port THEN CALL ClosePort(portname)
  1382. port=0
  1383. DO id=1 TO gads
  1384. CALL FREETHIS(newgadx.id)
  1385. CALL FREETHIS(newgadxi.id)
  1386. CALL FREETHIS(newgadxb.id)
  1387. CALL FREETHIS(glabels.id)
  1388. END
  1389. CALL FREETHIS(newgadbv)
  1390. CALL FREETHIS(mptr)
  1391. CALL FREETHIS(wtagl)
  1392. CALL FREETHIS(glistptr)
  1393. CALL FREETHIS(pubnptr)
  1394. cleangui=0
  1395. END
  1396. RETURN
  1397. options: 
  1398. GetTextBlockPrefs "TEXTFLOW FLOWDIST TEXT"
  1399. PARSE VAR RESULT defflow deffld deftext
  1400. defprfs=""
  1401. IF defflow~="" THEN defprfs=defprfs "TEXTFLOW" defflow
  1402. IF deffld~="" THEN defprfs=defprfs "FLOWDIST" deffld
  1403. IF deftext~="" THEN defprfs=defprfs "TEXT" deftext
  1404. GetTextBlockTypePrefs "SIZE LEADING WIDTH OBLIQUE POSITION CASE STYLE COLOR FONT"
  1405. PARSE VAR RESULT tsize tlead twid tobl tpos tcase tstyl tcol tfont
  1406. defspecs="SIZE" tsize "LEADING" tlead "WIDTH" twid "OBLIQUE" tobl "POSITION" tpos "CASE" tcase "STYLE" tstyl
  1407. defcolour="COLOR" tcol
  1408. IF Left(tfont,1)~=" " THEN tfont=" "||tfont 
  1409. deffont="FONT"||tfont
  1410. ssize=360
  1411. start="+0"
  1412. Status "PAGES"
  1413. docpages=RESULT
  1414. IF val.xgad~="" THEN ovalx=replacepat(val.xgad,",",".")
  1415. IF val.ygad~="" THEN ovaly=replacepat(val.ygad,",",".")
  1416. IF val.wgad~="" THEN ovalw=replacepat(val.wgad,",",".")
  1417. IF val.hgad~="" THEN ovalh=replacepat(val.hgad,",",".")
  1418. IF val.pgad~=0 THEN ovalp=Min(Max(val.pgad,1),docpages)
  1419. IF Left(text,Min(len.tgad,Length(text)))~=val.tgad THEN
  1420. DO
  1421. text=val.tgad
  1422. gadgettext=1
  1423. virtualtext=1
  1424. END
  1425. rescan=Length(text)=0
  1426. IF check.arc THEN ssize=SubStr("+-",cycle.arc+1,1)||val.arc
  1427. IF check.beg THEN start=SubStr(" -+",cycle.beg+1,1)||val.beg
  1428. norrot=~check.rot
  1429. IF check.rot THEN
  1430. IF cycle.rot=1 THEN
  1431. rrot="="
  1432. ELSE
  1433. IF cycle.rot=0 THEN
  1434. rrot=val.rot
  1435. ELSE
  1436. DO
  1437. rrot=SubStr("+-",cycle.rot//2+1,1)||val.rot
  1438. IF cycle.rot>3 THEN rrot=" "||rrot
  1439. END
  1440. ELSE
  1441. rrot=""
  1442. delete=SubStr("- +=",cycle.dlt+1,1)
  1443. ogrp=SubStr(" +-",cycle.grp+1,1)
  1444. dordim=check.spl
  1445. rdim=""
  1446. IF check.spl THEN rdim=SubStr("+-",cycle.spl+1,1)||val.spl
  1447. dohdim=check.siz | check.spl
  1448. hdim=""
  1449. IF check.siz THEN
  1450. hdim=SubStr("+-",cycle.siz+1,1)||val.siz
  1451. ELSE
  1452. IF check.spl THEN hdim=rdim
  1453. doresize=check.zoo
  1454. IF check.zoo THEN
  1455. DO
  1456. resize=val.zoo
  1457. resizek=SubStr("+|-",cycle.zoo+1,1)
  1458. END
  1459. adjust=cycle.adj
  1460. doadj=(adjust>0)
  1461. fillcol=cycle.ink//2
  1462. shadow=cycle.ink=3 | cycle.ink=4
  1463. resetcol=(cycle.ink=0) | shadow
  1464. attr=check.pat
  1465. wordmd=check.wrd
  1466. charmd=~wordmd
  1467. IF ssize=0 THEN ssize=0.01 
  1468. absstart=0
  1469. IF Verify(Left(start,1),"+-","m")=0 THEN
  1470. DO
  1471. absstart=1
  1472. start=Max(Min(start,360),0)
  1473. END
  1474. ELSE
  1475. start=Max(Min(start,360),-360)
  1476. IF dordim THEN
  1477. rdim=Max(Min(rdim,100),-100)
  1478. ELSE
  1479. ssize=Max(Min(ssize,360),-360)
  1480. IF rdim=0 THEN rdim=0.01
  1481. IF dohdim THEN
  1482. hdim=Max(Min(hdim,100),-100)
  1483. ELSE
  1484. hdim=rdim
  1485. IF hdim=0 THEN hdim=0.01
  1486. IF doresize THEN
  1487. DO
  1488. resizex=Max(Min(resize,1000),5)/100
  1489. resizey=resizex
  1490. resize=resizex
  1491. IF resizek="|" THEN
  1492. resizex=1
  1493. ELSE
  1494. IF resizek="-" THEN resizey=1
  1495. END
  1496. drot=0
  1497. deltarot=0
  1498. dodrot=0
  1499. IF Verify(Left(rrot,1),"+-","m")>0 THEN
  1500. DO
  1501. drot=Max(Min(rrot,360),-360)
  1502. rrot=""
  1503. norrot=1
  1504. END
  1505. ELSE
  1506. IF Left(rrot,1)=" " & rrot~="" THEN
  1507. DO
  1508. deltarot=Max(Min(rrot,360),-360)
  1509. dodrot=1
  1510. rrot=0
  1511. END
  1512. ELSE
  1513. IF rrot~="" & rrot~="=" THEN rrot=Max(Min(rrot,360),-360)
  1514. IF rrot="=" THEN rrot=txtrot||" "
  1515. RETURN
  1516. chosenobjs: 
  1517. ovalrescan=0
  1518. txtrescan=0
  1519. txt=0
  1520. oval=0
  1521. len=0
  1522. FirstObject "SELECTED"
  1523. o=RESULT
  1524. IF o~=0 THEN
  1525. DO
  1526. cnt=0
  1527. DO UNTIL o=0
  1528. gobj.cnt=o
  1529. NextObject o "SELECTED"
  1530. o=RESULT
  1531. cnt=cnt+1
  1532. END
  1533. DO i=0 TO cnt-1 WHILE oval=0 | txt=0
  1534. GetObjectType gobj.i
  1535. IF RESULT=7 THEN txt=gobj.i
  1536. IF RESULT=6 THEN oval=gobj.i
  1537. END
  1538. END
  1539. IF oval=0 THEN
  1540. oval=oldoval
  1541. ELSE
  1542. ovalrescan=1
  1543. IF gadgettext THEN len=Length(text)
  1544. IF gadgettext & ~(init | rescan) THEN txt=0
  1545. CALL getattr
  1546. Status "PARAPOS"
  1547. pos=RESULT
  1548. PARSE VAR pos para ppos x
  1549. Status "PARACHARS"
  1550. plen=RESULT
  1551. IF txt=0 & ~newattr THEN
  1552. IF Words(pos)=4  & (~gadgettext | rescan | init) THEN
  1553. DO
  1554. Extract
  1555. text=RESULT
  1556. len=Length(text)
  1557. IF C2X(Right(text,1))="0A" THEN len=len-1 
  1558. text=""
  1559. MoveToPara para ppos
  1560. virtualtext=0
  1561. ppos=0
  1562. END
  1563. ELSE
  1564. IF plen~=0 & (rescan | ((plen~=oldplen | para~=oldpara | ppos~=oldppos) & ~gadgettext)) THEN
  1565. DO
  1566. len=plen
  1567. text=""
  1568. virtualtext=0
  1569. IF ppos~=0 THEN MoveToPara para 0
  1570. ppos=0
  1571. END
  1572. IF txt>0 THEN
  1573. DO
  1574. GetTextBlockText txt
  1575. text=RESULT
  1576. len=Length(text)
  1577. END
  1578. IF len=0 THEN
  1579. DO
  1580. objs=oldobjs
  1581. len=oldlen
  1582. END
  1583. ELSE
  1584. txtrescan=1
  1585. IF (len=0 | oval=0) & ~init THEN
  1586. DO
  1587. IF len=0 & text~="" THEN
  1588. DO
  1589. len=Length(text)
  1590. txtrescan=1
  1591. END
  1592. IF oval=0 & ovalx~="" & ovaly~="" & ovalw~="" & ovalh~="" & ovalp~="" THEN oval=-1
  1593. IF len=0 | oval=0 THEN
  1594. DO
  1595. CALL message(0,noselect)
  1596. RETURN 5
  1597. END
  1598. END
  1599. gadgettext=0
  1600. oldoval=oval
  1601. oldtxt=txt
  1602. oldlen=len
  1603. oldobjs=objs
  1604. oldpara=para
  1605. oldppos=ppos
  1606. oldplen=plen
  1607. redrawchars=1
  1608. RETURN 0
  1609. getattr: 
  1610. newattr=0
  1611. IF ~attr | init THEN RETURN 5
  1612. Status "PARAPOS"
  1613. pos=RESULT
  1614. IF Words(pos)~=4 THEN RETURN 5
  1615. PARSE VAR pos para ppos x
  1616. Extract
  1617. atext=RESULT
  1618. MoveToPara para ppos
  1619. alen=Length(atext)
  1620. IF C2X(Right(atext,1))="0A" THEN alen=alen-1 
  1621. IF alen=0 THEN RETURN 5
  1622. DO i=1 TO alen
  1623. Cursor "RIGHT"
  1624. aspecs.i=gettexttypespecs()
  1625. Status "FONTNAME"
  1626. afont.i="FONT" RESULT
  1627. Status "FONTCOLOR"
  1628. acolour.i="COLOR" RESULT
  1629. IF quickmessy() THEN
  1630. DO
  1631. CALL remobjs
  1632. oldlen=0
  1633. alen=0
  1634. oldobjs=0
  1635. RETURN 5
  1636. END
  1637. END
  1638. MoveToPara para 0
  1639. oldppos=0
  1640. oldpara=para
  1641. Status "PARACHARS"
  1642. oldplen=RESULT
  1643. newattr=1
  1644. RETURN 0
  1645. oval: 
  1646. IF ovalrescan THEN
  1647. DO
  1648. GetObjectRotation oval
  1649. orot=RESULT
  1650. IF orot~=0 THEN SetObjectRotation oval 0
  1651. GetObjectCoords oval
  1652. PARSE VAR RESULT ovalp ovalx ovaly ovalw ovalh
  1653. val.xgad=Left(ovalx,Min(len.xgad,Length(ovalx)))
  1654. val.ygad=Left(ovaly,Min(len.ygad,Length(ovaly)))
  1655. val.wgad=Left(ovalw,Min(len.wgad,Length(ovalw)))
  1656. val.hgad=replacepat(Left(ovalh,Min(len.hgad,Length(ovalh)))," ","") 
  1657. val.pgad=Left(ovalp,Min(len.pgad,Length(ovalp)))
  1658. IF deci="COMMA" THEN
  1659. DO
  1660. val.xgad=replacepat(val.xgad,".",",")
  1661. val.ygad=replacepat(val.ygad,".",",")
  1662. val.wgad=replacepat(val.wgad,".",",")
  1663. val.hgad=replacepat(val.hgad,".",",")
  1664. END
  1665. IF cleangui THEN
  1666. DO
  1667. CALL GT_SetGadgetAttrs(intgad.xgad,win,Null(),GTST_STRING,val.xgad)
  1668. CALL GT_SetGadgetAttrs(intgad.ygad,win,Null(),GTST_STRING,val.ygad)
  1669. CALL GT_SetGadgetAttrs(intgad.wgad,win,Null(),GTST_STRING,val.wgad)
  1670. CALL GT_SetGadgetAttrs(intgad.hgad,win,Null(),GTST_STRING,val.hgad)
  1671. CALL GT_SetGadgetAttrs(intgad.pgad,win,Null(),GTIN_NUMBER,val.pgad)
  1672. END
  1673. GetObjectParams oval "TEXTFLOW FLOWDIST LINECOLOR FILLCOLOR"
  1674. PARSE VAR RESULT flow fld ovlcol ovfcol
  1675. IF Left(flow,5)="Right" THEN
  1676. flow="Right"
  1677. ELSE
  1678. IF Left(flow,4)="Left" THEN flow="Left"
  1679. IF delete="=" THEN
  1680. DO
  1681. SelectObject oval
  1682. Copy
  1683. END
  1684. IF delete~="-" & ogrp=" " THEN
  1685. DeleteObject oval
  1686. ELSE
  1687. IF doresize THEN SetObjectCoords oval x+rx*(1-resizex) y+ry*(1-resizey) rx*resizex*2 ry*resizey*2
  1688. ovalscanned=1
  1689. END
  1690. IF oval~=0 THEN
  1691. DO
  1692. GetPageSetup "WIDTH" "HEIGHT"
  1693. PARSE VAR RESULT pagew pageh
  1694. rx=ovalw/2
  1695. ry=ovalh/2
  1696. xm=Min(ovalx,pagew)+rx
  1697. ym=Min(ovaly,pageh)+ry
  1698. page=ovalp
  1699. END
  1700. IF ~ovalscanned THEN 
  1701. DO
  1702. GetOvalPrefs "TEXTFLOW FLOWDIST LINECOLOR FILLCOLOR"
  1703. PARSE VAR RESULT flow fld ovlcol ovfcol
  1704. IF Left(flow,5)="Right" THEN
  1705. flow="Right"
  1706. ELSE
  1707. IF Left(flow,4)="Left" THEN flow="Left"
  1708. orot=0
  1709. END
  1710. IF fillcol THEN
  1711. ovcol=ovfcol
  1712. ELSE
  1713. ovcol=ovlcol
  1714. TextBlockPrefs "TEXTFLOW" flow "FLOWDIST" fld
  1715. IF ~resetcol THEN TextBlockTypePrefs "COLOR" ovcol
  1716. RETURN
  1717. text: 
  1718. usesheet=alen>0 & attr
  1719. IF ~(txtrescan | dirtysize | (sheetused ^ usesheet) | newattr) THEN RETURN
  1720. DO i=1 TO len
  1721. x=SubStr(text,i,1)
  1722. IF usesheet THEN 
  1723. DO
  1724. attrn=(i-1)//alen+1
  1725. TextBlockTypePrefs afont.attrn
  1726. IF resetcol THEN
  1727. TextBlockTypePrefs aspecs.attrn acolour.attrn
  1728. ELSE
  1729. TextBlockTypePrefs aspecs.attrn
  1730. END
  1731. ELSE
  1732. DO
  1733. j=i-1
  1734. IF font.i~=font.j THEN TextBlockTypePrefs font.i
  1735. IF resetcol & (colour.i~=colour.j) THEN
  1736. TextBlockTypePrefs specs.i colour.i
  1737. ELSE
  1738. IF specs.i~=specs.j THEN TextBlockTypePrefs specs.i
  1739. END
  1740. IF Verify(x,'";= ',"M")  THEN x='"'||x||'"'
  1741. DrawTextBlock page xm ym x
  1742. obj.i=RESULT
  1743. objs=objs+1
  1744. IF check.mrel THEN Redraw
  1745. GetObjectCoords
  1746. PARSE VAR RESULT x x x objw.objs objh.objs
  1747. IF quickmessy() THEN
  1748. DO
  1749. CALL remobjs
  1750. dirtysize=1
  1751. oldlen=0
  1752. oldobjs=0
  1753. RETURN
  1754. END
  1755. END
  1756. sheetused=usesheet 
  1757. dirtysize=0
  1758. redrawchars=0
  1759. RETURN
  1760. scan: 
  1761. IF ~(txtrescan | dirtytext) | len=0 THEN RETURN
  1762. IF txt>0 THEN
  1763. DO
  1764. redrawchars=0
  1765. GetObjectTypeSpecs txt "SIZE LEADING WIDTH OBLIQUE POSITION CASE STYLE COLOR FONT"
  1766. PARSE VAR RESULT tsize tlead twid tobl tpos tcase tstyl tcol tfont
  1767. prfs="SIZE" tsize "LEADING" tlead "WIDTH" twid "OBLIQUE" tobl "POSITION" tpos "CASE" tcase "STYLE" tstyl
  1768. colourp="COLOR" tcol
  1769. IF Left(tfont,1)~=" " THEN tfont=" "||tfont 
  1770. fontp="FONT"||tfont
  1771. GetObjectRotation txt
  1772. txtrot=RESULT
  1773. IF delete="+" THEN DeleteObject txt
  1774. IF Right(rrot,1)=" " THEN rrot=txtrot
  1775. virtualtext=0
  1776. DO i=1 TO len
  1777. specs.i=prfs
  1778. font.i=fontp
  1779. colour.i=colourp
  1780. END
  1781. END
  1782. ELSE
  1783. IF virtualtext THEN
  1784. DO i=1 TO len
  1785. specs.i=defspecs
  1786. font.i=deffont
  1787. colour.i=defcolour
  1788. END
  1789. ELSE
  1790. IF text="" | dirtytext THEN
  1791. DO
  1792. text=""
  1793. DO i=1 TO len
  1794. Extract
  1795. x=rembad(RESULT)
  1796. text=text||x
  1797. Cursor "RIGHT"
  1798. specs.i=gettexttypespecs()
  1799. Status "FONTNAME"
  1800. font.i="FONT" RESULT
  1801. Status "FONTCOLOR"
  1802. colour.i="COLOR" RESULT
  1803. IF quickmessy() THEN
  1804. DO
  1805. CALL remobjs
  1806. oldlen=0
  1807. dirtytext=1
  1808. oldobjs=0
  1809. RETURN
  1810. END
  1811. END
  1812. MoveToPara para 0
  1813. val.tgad=Left(text,Min(len.tgad,Length(text)))
  1814. IF cleangui THEN CALL GT_SetGadgetAttrs(intgad.tgad,win,Null(),GTST_STRING,val.tgad)
  1815. END
  1816. dirtytext=0
  1817. IF text~="" THEN
  1818. DO
  1819. IF C2X(Right(text,1))="0A" THEN
  1820. DO
  1821. len=len-1
  1822. text=Left(text,len)
  1823. END
  1824. text=rembad(text)
  1825. old=val.tgad
  1826. val.tgad=Left(text,Min(len.tgad,Length(text)))
  1827. IF cleangui & val.tgad~=old THEN CALL GT_SetGadgetAttrs(intgad.tgad,win,Null(),GTST_STRING,val.tgad)
  1828. END
  1829. RETURN
  1830. initwrap: 
  1831. txtw=0
  1832. wnr=1
  1833. wordbeg=1
  1834. wordw=0
  1835. IF wordmd THEN
  1836. DO
  1837. wn=1
  1838. whi.wn=0
  1839. DO n=1 TO len
  1840. whi.wn=Max(objh.n,whi.wn)
  1841. IF SubStr(text,n,1)=" " | n=len THEN
  1842. DO
  1843. txtw=txtw+whi.wn
  1844. wn=wn+1
  1845. whi.wn=0
  1846. END
  1847. END
  1848. END
  1849. ELSE
  1850. DO n=1 TO len
  1851. txtw=txtw+objw.n
  1852. END
  1853. PI=3.141593
  1854. deg2rad=PI/180
  1855. smin=0.1 
  1856. rx=Max(rx,smin)
  1857. ry=Max(ry,smin)
  1858. sizerad=ssize*deg2rad
  1859. angstep=sizerad/txtw
  1860. IF doresize THEN angstep=angstep/resize
  1861. IF absstart THEN
  1862. angstart=start*deg2rad
  1863. ELSE
  1864. angstart=(ssize-360+start*2)/2*deg2rad
  1865. adone=angstart
  1866. flip=Sign(ssize)
  1867. ssize=ssize<0
  1868. fr=0
  1869. IF dordim THEN
  1870. DO
  1871. fr=(1-Abs(rdim)/100)/sizerad*Sign(rdim)
  1872. IF rdim<0 THEN
  1873. fr0=Abs(rdim)/100
  1874. ELSE
  1875. fr0=1
  1876. END
  1877. ELSE
  1878. qr=1
  1879. IF dohdim THEN
  1880. DO
  1881. fh=(1-Abs(hdim)/100)/sizerad*Sign(hdim)
  1882. IF hdim<0 THEN
  1883. fh0=Abs(hdim)/100
  1884. ELSE
  1885. fh0=1
  1886. END
  1887. ELSE
  1888. qh=1
  1889. wdone=0
  1890. o=0
  1891. rxx=rx
  1892. ryy=ry
  1893. IF doresize THEN
  1894. DO
  1895. rxx=rxx*resizex
  1896. ryy=ryy*resizey
  1897. END
  1898. sobjs=0
  1899. resetprefs=redrawchars | shadow
  1900. recalcchar=resetprefs | wordmd
  1901. usesheet=(alen>0) & attr
  1902. RETURN
  1903. wrap: 
  1904. CALL initwrap
  1905. DO n=1 TO len
  1906. IF recalcchar THEN
  1907. DO
  1908. char=SubStr(text,n,1)
  1909. IF Verify(char,'";= ',"M")  THEN char='"'||char||'"'
  1910. END
  1911. cw=objw.n
  1912. ch=objh.n
  1913. o=obj.n
  1914. IF charmd THEN
  1915. DO
  1916. CALL position
  1917. x=rxx*Sin(f)*qr-cw/2
  1918. y=ryy*Cos(f)*qr
  1919. IF ~check.mrel THEN y=y-ch/2
  1920. END
  1921. IF resetprefs THEN
  1922. DO
  1923. IF usesheet THEN
  1924. DO
  1925. attrn=(n-1)//alen+1
  1926. TextBlockTypePrefs afont.attrn
  1927. IF resetcol THEN
  1928. TextBlockTypePrefs aspecs.attrn acolour.attrn
  1929. ELSE
  1930. TextBlockTypePrefs aspecs.attrn
  1931. END
  1932. ELSE
  1933. DO
  1934. m=n-1
  1935. IF font.n~=font.m THEN TextBlockTypePrefs font.n
  1936. IF resetcol & (colour.n~=colour.m | shadow) THEN
  1937. TextBlockTypePrefs specs.n colour.n
  1938. ELSE
  1939. IF specs.n~=specs.m THEN TextBlockTypePrefs specs.n
  1940. END
  1941. END
  1942. IF wordmd THEN
  1943. DO
  1944. x=wordw
  1945. y=(whi.wnr-objh.n)/2
  1946. wordw=wordw+objw.n
  1947. crot=0
  1948. END
  1949. IF redrawchars THEN
  1950. DO
  1951. DrawTextBlock page x+xm y+ym char
  1952. obj.n=RESULT
  1953. objs=objs+1
  1954. IF check.mrel THEN Redraw
  1955. o=obj.n
  1956. IF cw~=objw.n | ch~=objh.n THEN SetObjectCoords o page x+xm y+ym cw ch
  1957. END
  1958. ELSE
  1959. SetObjectCoords o page x+xm y+ym cw ch
  1960. SetObjectRotation o crot
  1961. IF shadow THEN
  1962. DO
  1963. TextBlockTypePrefs "COLOR" ovcol
  1964. DrawTextBlock page x+xm+rx/10 y+ym+ry/10 char
  1965. sobj.n=RESULT
  1966. sobjs=sobjs+1
  1967. IF check.mrel THEN Redraw
  1968. IF cw~=objw.n | ch~=objh.n THEN SetObjectCoords sobj.n page x+xm+rx/10 y+ym+ry/10 cw ch
  1969. SetObjectRotation sobj.n crot
  1970. END
  1971. IF wordmd THEN
  1972. IF char='" "' | n=len THEN CALL endofword
  1973. IF quickmessy() THEN
  1974. DO
  1975. CALL remobjs
  1976. RETURN
  1977. END
  1978. END
  1979. RETURN
  1980. position: 
  1981. IF doresize THEN
  1982. DO
  1983. cw=cw*resize
  1984. ch=ch*resize
  1985. END
  1986. f=angstart-angstep*(wdone+cw/2)
  1987. wdone=wdone+cw
  1988. IF dordim THEN qr=fr0+fr*(f-angstart)
  1989. IF dohdim THEN
  1990. DO
  1991. qh=fh0+fh*(f-angstart)
  1992. ch=Max(ch*qh,smin)
  1993. cw=Max(cw*qh,smin)
  1994. END
  1995. IF doadj THEN
  1996. IF adjust=4 THEN
  1997. DO
  1998. asize=1.1*cw/radius(adone,rxx,ryy,qr)
  1999. f=adone-asize/2*flip
  2000. adone=adone-asize*flip
  2001. END
  2002. ELSE
  2003. DO
  2004. carc=radius(f,rxx,ryy,qr)*angstep/qr
  2005. IF adjust=1 THEN ch=ch*carc
  2006. IF adjust=3 THEN ch=ch/Sqrt(carc)
  2007. cw=cw*carc
  2008. END
  2009. IF norrot THEN
  2010. crot=720-Trunc(Atan(ryy/rxx*Tan(f))/PI*180)+180*((Cos(f)>0)+ssize)+drot
  2011. ELSE
  2012. DO
  2013. IF dodrot & n=1 THEN rrot=720-Trunc(Atan(ryy/rxx*Tan(f))/PI*180)+180*((Cos(f)>0)+ssize)
  2014. crot=rrot+deltarot*(n-1)//360+360
  2015. END
  2016. crot=crot//360
  2017. RETURN
  2018. endofword: 
  2019. cw=whi.wnr
  2020. ch=1
  2021. CALL position
  2022. x=rxx*Sin(f)*qr-wordw/2
  2023. y=ryy*Cos(f)*qr-whi.wnr
  2024. crot=(crot+270)//360
  2025. IF shadow THEN
  2026. DO
  2027. SelectObject
  2028. DO i=wordbeg TO n
  2029. SelectObject sobj.i "MULTIPLE"
  2030. END
  2031. Group
  2032. CurrentObject
  2033. wsobj.wnr=RESULT
  2034. GetObjectCoords
  2035. SetObjectCoords wsobj.wnr page x+xm+rx/10 y+ym+ry/10 Word(RESULT,4)*ch Word(RESULT,5)*cw/whi.wnr
  2036. SetObjectRotation wsobj.wnr crot
  2037. END
  2038. SelectObject
  2039. DO i=wordbeg TO n
  2040. SelectObject obj.i "MULTIPLE"
  2041. END
  2042. Group
  2043. CurrentObject
  2044. wobj.wnr=RESULT
  2045. GetObjectCoords
  2046. SetObjectCoords wobj.wnr page x+xm y+ym Word(RESULT,4)*ch Word(RESULT,5)*cw/whi.wnr
  2047. SetObjectRotation wobj.wnr crot
  2048. wordbeg=n+1
  2049. wnr=wnr+1
  2050. wordw=0
  2051. RETURN
  2052. group: 
  2053. IF ~ovalrescan & ogrp~=" " THEN
  2054. DO
  2055. DrawOval ovalp ovalx ovaly ovalw ovalh
  2056. oval=RESULT
  2057. ovalrescan=1
  2058. Redraw
  2059. END
  2060. IF ovalrescan THEN
  2061. DO
  2062. IF ogrp="-" THEN
  2063. DO
  2064. SelectObject oval
  2065. SetObjectParams oval "LINEWT NONE FILL TRANSPARENT"
  2066. END
  2067. IF orot~=0 & delete="-" & ogrp=" " THEN SetObjectRotation oval orot
  2068. END
  2069. SelectObject
  2070. IF wordmd THEN
  2071. DO n=1 TO wnr-1
  2072. SelectObject wobj.n "MULTIPLE"
  2073. END
  2074. ELSE
  2075. DO n=1 TO objs
  2076. SelectObject obj.n "MULTIPLE"
  2077. END
  2078. Group
  2079. i=RESULT
  2080. IF ogrp~=" " THEN
  2081. DO
  2082. SelectObject oval "MULTIPLE"
  2083. Group
  2084. END
  2085. objs=0
  2086. IF orot~=0 THEN SetObjectRotation 0 orot
  2087. IF shadow THEN
  2088. DO
  2089. SelectObject
  2090. IF wordmd THEN
  2091. DO n=1 TO wnr-1
  2092. SelectObject wsobj.n "MULTIPLE"
  2093. END
  2094. ELSE
  2095. DO n=1 TO sobjs
  2096. SelectObject sobj.n "MULTIPLE"
  2097. END
  2098. Group
  2099. sobjs=0
  2100. IF orot~=0 THEN SetObjectRotation 0 orot
  2101. ObjectToBack 0
  2102. END
  2103. Redraw
  2104. RETURN
  2105. bye: 
  2106. PARSE ARG errnr
  2107. errtrap=-2
  2108. IF errnr=0 & lockcnt>0 THEN RETURN
  2109. IF stilltoreply THEN CALL Reply(replymsg,10)
  2110. CALL resetprefs
  2111. CALL guiclean
  2112. CALL remobjs
  2113. EXIT errnr
  2114. RETURN
  2115. remobjs: 
  2116. IF objs>0 THEN
  2117. DO
  2118. IF wordmd THEN
  2119. DO n=1 TO wnr-1
  2120. SelectObject wobj.n
  2121. UnGroup
  2122. END
  2123. SelectObject
  2124. DO n=1 TO objs
  2125. SelectObject obj.n "MULTIPLE"
  2126. END
  2127. Group
  2128. DeleteObject
  2129. objs=0
  2130. END
  2131. IF sobjs>0 THEN
  2132. DO
  2133. SelectObject
  2134. IF wordmd THEN
  2135. DO n=1 TO wnr-1
  2136. SelectObject wsobj.n
  2137. UnGroup
  2138. END
  2139. DO n=1 TO sobjs
  2140. SelectObject sobj.n "MULTIPLE"
  2141. END
  2142. Group
  2143. DeleteObject
  2144. sobjs=0
  2145. END
  2146. RETURN
  2147. resetprefs: 
  2148. IF deci~="" THEN DocItemPrefs "DECIMAL PERIOD"
  2149. IF defprfs~="" THEN TextBlockPrefs defprfs
  2150. IF defspecs~="" | defcolour~="" THEN TextBlockTypePrefs defspecs defcolour
  2151. IF deffont~="" THEN TextBlockTypePrefs deffont
  2152. IF deci~="" THEN DocItemPrefs "DECIMAL" deci
  2153. RETURN
  2154. loaddef: 
  2155. ARG where
  2156. CALL loadtemp
  2157. IF where>0 THEN
  2158. DO
  2159. ok=0
  2160. DO i=where TO 3-where BY 3-where*2 UNTIL ok
  2161. IF preff.i~="" THEN
  2162. DO
  2163. ok=Open(prefs,preff.i,"R")
  2164. IF ok THEN
  2165. DO
  2166. default=ReadCh(prefs,prefsize+6)
  2167. CALL Close(prefs)
  2168. END
  2169. END
  2170. END
  2171. END
  2172. ELSE
  2173. default=""
  2174. IF Length(default)~=prefsize+6 | Left(default,6)~=prefsid | C2D(SubStr(default,5,2))~=prefsize THEN default=""
  2175. IF default="" THEN 
  2176. DO
  2177. winx=defwinx
  2178. winy=defwiny
  2179. DO id=1 TO agads
  2180. check.id=defchk.id
  2181. cycle.id=defcyc.id
  2182. val.id=defval.id
  2183. END
  2184. DO id=menuoff+1 TO menuoff+mchks
  2185. check.id=defchk.id
  2186. END
  2187. DO id=agads+1 TO agads+sgads
  2188. IF gtype.id=0 THEN
  2189. val.id=1
  2190. ELSE
  2191. val.id=""
  2192. END
  2193. END
  2194. ELSE 
  2195. DO
  2196. winx=C2D(SubStr(default,7,2))
  2197. winy=C2D(SubStr(default,9,2))
  2198. DO id=1 TO agads
  2199. i=id*4
  2200. check.id=C2D(SubStr(default,i+7,1))~=0
  2201. cycle.id=Min(Max(C2D(SubStr(default,i+8,1)),0),Abs(labs.id))
  2202. val.id=Min(Max(C2D(SubStr(default,i+9,2)),0),9999)
  2203. END
  2204. DO id=menuoff+1 TO menuoff+mchks
  2205. check.id=C2D(SubStr(default,id+agads*4-menuoff+10,1))~=0
  2206. END
  2207. END
  2208. CALL updategadgets
  2209. RETURN
  2210. savedef: 
  2211. ARG where
  2212. CALL savetemp
  2213. winx=GETVALUE(win,4,2,"N")
  2214. winy=GETVALUE(win,6,2,"N")
  2215. default=prefsid||D2C(winx,2)||D2C(winy,2)
  2216. DO id=1 TO agads
  2217. default=default||D2C(check.id,1)||D2C(cycle.id,1)||D2C(val.id,2)
  2218. END
  2219. DO id=menuoff+1 TO menuoff+mchks
  2220. default=default||D2C(check.id,1)
  2221. END
  2222. DO i=1 TO where
  2223. IF preff.i~="" THEN
  2224. DO
  2225. ok=Open(prefs,preff.i,"W")
  2226. IF ok THEN
  2227. DO
  2228. CALL WriteCh(prefs,default)
  2229. CALL Close(prefs)
  2230. END
  2231. END
  2232. END
  2233. RETURN
  2234. loadtemp: 
  2235. IF tempsize=0 THEN RETURN
  2236. ok=Open(prefs,temp,"R")
  2237. IF ok THEN
  2238. DO
  2239. default=ReadCh(prefs,tempsize)
  2240. i=1
  2241. IF Length(default)=tempsize THEN
  2242. DO id=agads+1 TO agads+sgads
  2243. val.id=replacepat(SubStr(default,i,len.id),D2C(0),"")
  2244. i=i+len.id
  2245. END
  2246. CALL Close(prefs)
  2247. END
  2248. RETURN
  2249. savetemp: 
  2250. IF tempsize=0 THEN RETURN
  2251. ok=Open(prefs,temp,"W")
  2252. IF ok THEN
  2253. DO
  2254. default=""
  2255. DO id=agads+1 TO agads+sgads
  2256. default=default||Left(val.id,len.id,D2C(0))
  2257. END
  2258. CALL WriteCh(prefs,default)
  2259. CALL Close(prefs)
  2260. END
  2261. RETURN
  2262. updategadgets: 
  2263. IF ~cleangui THEN RETURN
  2264. DO id=1 TO agads
  2265. IF labs.id>=0 THEN CALL GT_SetGadgetAttrs(checkgad.id,win,Null(),GTCB_CHECKED,check.id)
  2266. IF labs.id~=0 THEN CALL GT_SetGadgetAttrs(cyclegad.id,win,Null(),GTCY_ACTIVE,cycle.id)
  2267. IF labs.id>0 THEN CALL GT_SetGadgetAttrs(intgad.id,win,Null(),GTIN_NUMBER,val.id)
  2268. END
  2269. DO id=agads+1 TO agads+sgads
  2270. IF gtype.id>0 THEN
  2271. CALL GT_SetGadgetAttrs(intgad.id,win,Null(),GTST_STRING,val.id)
  2272. ELSE
  2273. CALL GT_SetGadgetAttrs(intgad.id,win,Null(),GTIN_NUMBER,val.id)
  2274. END
  2275. CALL ClearMenuStrip(win)
  2276. item=GETVALUE(menu,18,4,"P")
  2277. DO n=menuoff+1 TO menuoff+mchks
  2278. flags=C2D(B2C(BitAnd(C2B(D2C(GETVALUE(item,12,2,"N"),2)),"1111111011111111")))+CHECKED*check.n
  2279. CALL SETVALUE(item,12,2,"N",flags,0)
  2280. item=GETVALUE(item,0,4,"P")
  2281. END
  2282. CALL ResetMenuStrip(win,menu)
  2283. RETURN
  2284. newdoc: 
  2285. IF portok THEN
  2286. DO
  2287. Status "FILENAME"
  2288. doc=RESULT
  2289. WinToFront
  2290. END
  2291. ELSE
  2292. doc="???"
  2293. IF doc="" THEN doc=unnamed
  2294. wintitle=replacepat(wtitle,"%f",doc)
  2295. scrtitle=replacepat(stitle,"%f",doc)
  2296. IF cleangui THEN
  2297. DO
  2298. CALL SetWindowTitles(win,wintitle,scrtitle)
  2299. IF ~windowpos THEN CALL WindowToFront(win)
  2300. CALL ActivateWindow(win)
  2301. END
  2302. RETURN
  2303. SYNTAX: 
  2304. et=ErrorText(RC)
  2305. ERROR:
  2306. err=RC
  2307. line=SIGL
  2308. IF errtrap=-1 THEN CALL bye(err)
  2309. IF errtrap=-2 THEN EXIT err
  2310. IF err=errtrap THEN
  2311. DO
  2312. errtrap=0
  2313. i=resume
  2314. DROP resume
  2315. trapped=1
  2316. SIGNAL VALUE i
  2317. END
  2318. RESUME:
  2319. errtrap=-1
  2320. IF et="" THEN et=fwerrtext.err
  2321. CALL message(err,replacepat(replacepat(replacepat(replacepat(errtext,"%n",err),"%l",line),"%t",et),"%s",SourceLine(line)))
  2322. CALL bye(err)
  2323. RETURN
  2324. BREAK_C: 
  2325. CALL bye(2)
  2326. RETURN
  2327. rembad: PROCEDURE 
  2328. PARSE ARG t
  2329. bad=XRange("00"x,"1F"x)||XRange("7F"x,"A0"x)
  2330. i=Verify(t,bad,"m")
  2331. l=Length(t)
  2332. DO WHILE i>0
  2333. t=Left(t,i-1) Right(t,l-i)
  2334. i=Verify(t,bad,"m")
  2335. END
  2336. RETURN t
  2337. replacepat: PROCEDURE 
  2338. PARSE ARG str,pat,replc
  2339. p=Pos(pat,str)
  2340. DO WHILE p>0
  2341. str=Left(str,p-1)||replc||SubStr(str,p+Length(pat))
  2342. p=Pos(pat,str)
  2343. END
  2344. RETURN str
  2345. gettexttypespecs: PROCEDURE 
  2346. Status "FONTSIZE"
  2347. p="SIZE" RESULT
  2348. Status "FONTWIDTH"
  2349. p=p "WIDTH" RESULT
  2350. Status "FONTOBLIQUE"
  2351. p=p "OBLIQUE" RESULT
  2352. RETURN p
  2353. radius: PROCEDURE 
  2354. ARG a,rx,ry,v
  2355. rx=rx*Cos(a)
  2356. ry=ry*Sin(a)
  2357. r=v*Sqrt(rx*rx+ry*ry)
  2358. RETURN r
  2359. getshort: PROCEDURE 
  2360. ARG ptr,offset
  2361. a=GETVALUE(D2C(ptr),offset,2,"N")
  2362. IF a>32767 THEN a=a-65536
  2363. RETURN a
  2364. xexists: PROCEDURE 
  2365. PARSE ARG file
  2366. IF Pos(":",file)>0 THEN
  2367. IF Pos(Upper(Left(file,Pos(":",file))),Upper(ShowList("A",,":")||ShowList("V",,":"))||":")>0 THEN
  2368. ok=Exists(file)
  2369. ELSE
  2370. ok=0
  2371. ELSE
  2372. ok=Exists(file)
  2373. RETURN ok
  2374. newchkitem: 
  2375. mchks=mchks+1
  2376. chk=mchks+agads+tgads+wgads+sgads
  2377. PARSE ARG ltxt.chk,mkey.chk,defchk.chk,mnode.chk
  2378. RETURN chk
  2379. newitem: 
  2380. macts=macts+1
  2381. nr=macts+mchks+agads+tgads+wgads+sgads
  2382. PARSE ARG ltxt.nr,mkey.nr,mnode.nr
  2383. RETURN nr
  2384. newgadget: 
  2385. agads=agads+1
  2386. PARSE ARG labs.agads,lkey.agads,defchk.agads,defval.agads,defcyc.agads,gnode.agads,lbound.agads,ubound.agads
  2387. RETURN agads
  2388. newstr: 
  2389. sgads=sgads+1
  2390. gad=sgads+agads
  2391. PARSE ARG len.gad,lkey.gad,line.gad,val.gad,gtype.gad,gnode.gad
  2392. check.gad=0
  2393. cycle.gad=0
  2394. labs.gad=1
  2395. slines=Max(slines,line.gad)
  2396. RETURN gad
  2397. newbutton: 
  2398. tgads=tgads+1
  2399. gad=tgads+agads+sgads
  2400. PARSE ARG ltxt.gad,lkey.gad,lkey2.gad,gnode.gad
  2401. RETURN gad
  2402. newkey: 
  2403. wgads=wgads+1
  2404. gad=agads+tgads+wgads+sgads
  2405. PARSE ARG lkey.gad,gnode.gad
  2406. RETURN gad
  2407. checksyntax: 
  2408. PARSE ARG par.1,par.2,par.3
  2409. ok=1
  2410. DO i=1 TO 3 WHILE par.i~=""
  2411. IF par.i=Upper(par.i) THEN INTERPRET "ar.i="||ar.i 
  2412. ok=ok & Datatype(ar.i,par.i)
  2413. END
  2414. RETURN ok
  2415. message: 
  2416. PARSE ARG xiterr,msgtxt,buttxt,titletxt
  2417. IF msgtxt="" THEN RETURN 0
  2418. IF buttxt="" THEN buttxt=stdbut
  2419. IF titletxt="" THEN titletxt=wintitle
  2420. IF lib.reqtools THEN
  2421. DO
  2422. resume="BACKMSG"
  2423. errtrap=14
  2424. button=RTEZRequest(replacepat(msgtxt,"|","0A"x),buttxt,titletxt)
  2425. END
  2426. BACKMSG:
  2427. IF trapped THEN 
  2428. DO
  2429. trapped=0
  2430. lib.reqtools=0
  2431. END
  2432. IF ~lib.reqtools THEN
  2433. IF lib.apig & cleangui & win~="00000000"x THEN
  2434. button=EasyRequest(win,titletxt,replacepat(msgtxt,"|","0A"x),buttxt,Null(),0,0)
  2435. ELSE
  2436. SAY replacepat(msgtxt,"|","0A"x)
  2437. IF xiterr>0 THEN CALL bye(xiterr)
  2438. RETURN button
  2439.